I want to add aboutbox/dialogbox on my Custom component. how to make the small button[...] appear on the object inspector? just like the assigning a picure on the Timage component.
You must define a property similar to this:
//: Información acerca del paquete de componentes
property AboutMe:TFAbout read FAboutG stored false;
TFAbout is a class, that define the form that you want to see (About form), when the user click on the property in "Object Inspector".
Additionally, you must register a "Property Editor", if you want see a buuton with the three point |...| in OI.
This is a sample unit:
unit UTAboutProp;
interface
uses
DesignIntf, DesignEditors;
type
TAboutGProp = class(TPropertyEditor)
public
procedure Edit(); override;
function GetValue(): string; override;
function GetAttributes(): TPropertyAttributes; override;
end;
implementation
uses
SysUtils, FormAbout, UConstantes;
procedure TAboutGProp.Edit();
begin
with TFAbout.Create(nil) do
try
ShowModal();
finally
Free();
end;
end;
function TAboutGProp.GetValue(): string;
begin
result := Format(GLIBSI_LBL,[GLIBSI_VERSION]);
result := '1.0';
end;
function TAboutGProp.GetAttributes(): TPropertyAttributes;
begin
result := [paDialog,paReadOnly];
end;
end.
Only rest to "register" this "property Editor" for work with your About property; This is important for "link" your property with your editor.
Where you have the code for register the component, add the code for register the property:
RegisterPropertyEditor(TypeInfo(TFAbout),nil,'',TAboutGProp);
Regards
Related
I'm developing a component for Query. It works like the "Properties" feature of DevExpress, but I need to place the order of the Unpublished Property I wrote to DFM with DefineProperties in the DFM file at the top of the TCollectionItem.
It works the same way in DevExpress. If you add a Field to the cxGrid and assign a value to the Properties property, you will see the value "PropertiesClassName" in the DFM file at the top.
When I open the DFM file and bring this Property to the top, the setter property of the "PropertiesClassName" Property works and I create that Class. It works seamlessly when reading data from the DFM stream. But no matter what I did I couldn't get the "PropertiesClassName" Property value to the top.
If you create a cxGrid on the form and add Field, and then take the "PropertiesClassName" property from DFM to the bottom of the DFM file, when you open the form again, you will see that it cannot find the relevant Class and an error occurs.
To change the DFM flow, I first assigned a value to the "PropertiesClassName" Property and then created the Class, but the problem was not solved. I did the opposite of this but the problem is still the same.
DFM Context
object QuerySearchEngine1: TQuerySearchEngine
SearchFields = <
item
FieldName = 'TestField'
Properties.Convert2String = True
PropertiesClassName = 'TSearchBooleanProperties'
end>
DFM Context should be like
object QuerySearchEngine1: TQuerySearchEngine
SearchFields = <
item
PropertiesClassName = 'TSearchBooleanProperties'
FieldName = 'TestField'
Properties.Convert2String = True
end>
Classes
TSearchField = class(TCollectionItem)
private
FFieldName: string;
FProperties: TSearchFieldProperties;
FPropertiesClassName: string;
private
procedure SetFieldName(const Value: string);
procedure SetProperties(const Value: TSearchFieldProperties);
private
procedure ReaderProc(Reader: TReader);
procedure WriterProc(Writer: TWriter);
procedure SetPropertiesClassName(const Value: string);
protected
constructor Create(Collection: TCollection); override;
procedure DefineProperties(Filer: TFiler); override;
public
property PropertiesClassName: string read FPropertiesClassName write SetPropertiesClassName;
published
property FieldName: string read FFieldName write SetFieldName;
property Properties: TSearchFieldProperties read FProperties write SetProperties;
end;
procedure TSearchField.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('PropertiesClassName', ReaderProc, WriterProc, FPropertiesClassName <> '');
end;
procedure TSearchField.SetPropertiesClassName(const Value: string);
begin
var Item: TSearchFieldPropertiesItem;
if TryValidateSearchFieldPropertiesClassName(Value, Item) then
begin
if not Assigned(FProperties) or not (FProperties.ClassType = Item.ClassType) then
begin
if Assigned(FProperties) then
begin
FProperties.Free;
FProperties := nil;
end;
FPropertiesClassName := Item.ClassType.ClassName;
FProperties := Item.ClassType.Create;
end;
end
else
begin
FPropertiesClassName := '';
if Assigned(FProperties) then
begin
FProperties.Free;
FProperties := nil;
end;
end;
end;
Property Editor
type
TSearchFieldPropertiesProperty = class(TClassProperty)
private
function GetInstance: TPersistent;
public
function GetAttributes: TPropertyAttributes; override;
procedure GetValues(Proc: TGetStrProc); override;
function GetValue: string; override;
procedure SetValue(const Value: string); override;
end;
function TSearchFieldPropertiesProperty.GetValue: string;
begin
for var I := 0 to Self.PropCount - 1 do
begin
var Inst := Self.GetComponent(I);
if Assigned(Inst) and Self.HasInstance(Inst) then
begin
if Inst is TSearchField then
begin
var PropInst := GetObjectProp(Inst, Self.GetPropInfo);
if Assigned(PropInst) then
begin
for var Item in SearchFieldPropertiesList do
begin
if PropInst.ClassType = Item.ClassType then
begin
Result := Item.Name;
Exit;
end;
end;
end;
end;
end;
end;
end;
procedure TSearchFieldPropertiesProperty.SetValue(const Value: string);
begin
var Item: TSearchFieldPropertiesItem;
if TryValidateSearchFieldPropertiesName(Value, Item) then
begin
var Inst := GetInstance;
if Assigned(Inst) then
begin
var Context := TRttiContext.Create;
var Rtype := Context.GetType(Inst.ClassType);
for var Prop in Rtype.GetProperties do
begin
if SameText(Prop.Name, 'PropertiesClassName') then
begin
Prop.SetValue(Inst, TValue.From<string>(Item.ClassType.ClassName));
Break;
end;
end;
end;
end;
end;
Pic for Design Time
The only problem is changing the order of the Property in that DFM flow.
Original answer at the bottom, here is a new suggestion:
We actually have something very similar in the JVCL where TJvHotTrackPersistent publishes a HotTrackOptions property.
This property is backed by an instance of TJvHotTrackOptions that gets derived in other classes that need specialized versions of it.
To tell the streaming subsystem to use the actual class found at streaming time, the constructor of that options class calls SetSubComponent(True); which places csSubComponent in the ComponentStyle property.
So what you should do is get rid of your DefineProperties, have TSearchFieldProperties inherit from TComponent and call SetSubComponent(True) in its constructor.
Then you create as many classes derived from TSearchFieldProperties as you need, each with its own set of published properties.
This means you should also get rid of the methods you showed in your submission.
In the end, you should have something along those lines:
type
TSearchFieldProperties = class(TComponent)
public
constructor Create(AOwner: TComponent); override;
end;
TIntegerSearchFieldProperties = class(TSearchFieldProperties)
private
FIntValue: Integer;
published
property IntValue: Integer read FIntValue write FIntValue;
end;
constructor TSearchFieldProperties.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
SetSubComponent(True);
end;
With this you do not fight against the streaming system but rather work with it in the way it is meant to be used.
But if you stop there, you'll notice there is no way for you to specify the actual class name to be used for the TSearchFieldProperties instance used for the TSearchField.Properties property.
The only way to get the class name to be streamed before the subcomponent is streamed is to actually declare the class name as a published property, declared before the subcomponent like this:
type
TSearchField = class(TCollectionItem)
published
// DO NOT change the order of those two properties, PropertiesClassName must come BEFORE Properties for DFM streaming to work properly
property PropertiesClassName: string read GetPropertiesClassName write SetPropertiesClassName;
property Properties: TSearchFieldProperties read FProperties write SetProperties;
end;
function TSearchField.GetPropertiesClassName: string;
begin
Result := Properties.ClassName;
end;
procedure TSearchField.SetPropertiesClassName(const AValue: string);
begin
FProperties.Free; // no need to test for nil, Free already does it
FProperties := TSearchFieldPropertiesClass(FindClass(AValue)).Create(self);
end;
It might work if you just declare the published property like without creating a csSubComponent hierarchy but you'll most likely stumble on other hurdles along the way.
Note: this answer is wrong because DefineProperties is called last in TWriter.WriteProperties and so there is no way to change the order properties defined like this are written.
What if you change your DefineProperties override from this:
procedure TSearchField.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('PropertiesClassName', ReaderProc, WriterProc, FPropertiesClassName <> '');
end;
to this:
procedure TSearchField.DefineProperties(Filer: TFiler);
begin
Filer.DefineProperty('PropertiesClassName', ReaderProc, WriterProc, FPropertiesClassName <> '');
inherited DefineProperties(Filer);
end;
Basically, call the inherited method AFTER you have defined your own property.
Note that I also specified which inherited method is called. I know it's not required, but it makes intent clearer and allows for Ctrl-Click navigation.
I'm trying to create a custom property editor for some custom component. The custom property editor is intended to edit some set property, like
type
TButtonOption = (boOption1, boOption2, boOption3);
TButtonOptions = set of TButtonOption;
my property editor descends from TSetProperty class. The problem is: my custom property editor doesn't get registered and Delphi IDE seems to use its own default set property editor, because ShowMessage() calls inside property editor methods never executes! I've created a sample package/component from scratch, as simple as possible, showing this issue. Here is the code:
unit Button1;
interface
uses
System.SysUtils, System.Classes, Vcl.Controls, Vcl.StdCtrls, DesignIntf, DesignEditors;
type
TButtonOption = (boOption1, boOption2, boOption3);
TButtonOptions = set of TButtonOption;
TButtonEx = class(TButton)
private
FOptions: TButtonOptions;
function GetOptions: TButtonOptions;
procedure SetOptions(Value: TButtonOptions);
published
property Options: TButtonOptions read GetOptions write SetOptions default [];
end;
TMySetProperty = class(TSetProperty)
public
function GetAttributes: TPropertyAttributes; override;
procedure GetProperties(Proc: TGetPropProc); override;
function GetValue: string; override;
end;
procedure Register;
implementation
uses
Dialogs;
// TButtonEx - sample component
function TButtonEx.GetOptions: TButtonOptions;
begin
Result := FOptions;
end;
procedure TButtonEx.SetOptions(Value: TButtonOptions);
begin
if FOptions <> Value then
begin
FOptions := Value;
end;
end;
// register stuff
procedure Register;
begin
RegisterComponents('Samples', [TButtonEx]);
RegisterPropertyEditor(TypeInfo(TButtonOptions), nil, '', TMySetProperty);
end;
function TMySetProperty.GetAttributes: TPropertyAttributes;
begin
ShowMessage('GetAttributes');
Result := inherited GetAttributes;
end;
procedure TMySetProperty.GetProperties(Proc: TGetPropProc);
begin
ShowMessage('GetProperties');
inherited;
end;
function TMySetProperty.GetValue: string;
begin
ShowMessage('GetValue');
Result := inherited GetValue;
end;
end.
Please note that:
I'm registering the new property editor (TMySetProperty) for ALL components having a TButtonOptions property. I also tried to do it for TButtonEx only, but the result is the same.
I've added ShowMessage() calls inside all overriden methods of my custom property editor and those methods NEVER get called.
I've already debugged the package and RegisterPropertyEditor() executes. Nevertheless, my custom code in overridden methods never execute.
I've seen other 3rd party components using such property editor (TSetProperty descendants) running in older Delphi IDEs and I could not find any relevant difference in code. Maybe Delphi XE2+ requires something else?
So the question is:
Why my custom property editor does not register/work?
Note: This issue happens in Delphi XE2, XE3, XE4 and also XE5 at least. Other IDEs were not tested but probably have the same behavior.
Finally I got a solution... After testing everything I could imagine - without success - I started searching for something "new" in DesignEditors.pas and DesignIntf.pas units. Reading GetEditorClass() function, I discovered that it first checks for a PropertyMapper. A property mapper can be registered using RegisterPropertyMapper() function. Using it instead of RegisterPropertyEditor() works just as expected. Here is my modified, working code, also showing some interesting application for this: show or hide some options of my set-based property, based on some criteria:
unit Button1;
interface
uses
System.SysUtils, System.Classes, Vcl.Controls, Vcl.StdCtrls,
DesignIntf, DesignEditors;
type
TButtonOption = (boOptionA, boOptionB, boOptionC);
TButtonOptions = set of TButtonOption;
type
TButtonEx = class(TButton)
private
FOptions: TButtonOptions;
function GetOptions: TButtonOptions;
procedure SetOptions(Value: TButtonOptions);
published
property Options: TButtonOptions read GetOptions write SetOptions default [];
end;
TMySetProperty = class(TSetProperty)
private
FProc: TGetPropProc;
procedure InternalGetProperty(const Prop: IProperty);
public
procedure GetProperties(Proc: TGetPropProc); override;
end;
procedure Register;
implementation
uses
TypInfo;
// TButtonEx - sample component
function TButtonEx.GetOptions: TButtonOptions;
begin
Result := FOptions;
end;
procedure TButtonEx.SetOptions(Value: TButtonOptions);
begin
if FOptions <> Value then
begin
FOptions := Value;
end;
end;
// Returns TMySetProperty as the property editor used for Options in TButtonEx class
function MyCustomPropMapper(Obj: TPersistent; PropInfo: PPropInfo): TPropertyEditorClass;
begin
Result := nil;
if Assigned(Obj) and (Obj is TButtonEx) and SameText(String(PropInfo.Name), 'Options') then begin
Result := TMySetProperty;
end;
end;
procedure Register;
begin
RegisterComponents('Samples', [TButtonEx]);
// RegisterPropertyEditor does not work for set-based properties.
// We use RegisterPropertyMapper instead
RegisterPropertyMapper(MyCustomPropMapper);
end;
procedure TMySetProperty.GetProperties(Proc: TGetPropProc);
begin
// Save the original method received
FProc := Proc;
// Call inherited, but passing our internal method as parameter
inherited GetProperties(InternalGetProperty);
end;
procedure TMySetProperty.InternalGetProperty(const Prop: IProperty);
var
i: Integer;
begin
if not Assigned(FProc) then begin // just in case
Exit;
end;
// Now the interesting stuff. I just want to show boOptionA and boOptionB in Object inspector
// So I call the original Proc in those cases only
// boOptionC still exists, but won't be visible in object inspector
for i := 0 to PropCount - 1 do begin
if SameText(Prop.GetName, 'boOptionA') or SameText(Prop.GetName, 'boOptionB') then begin
FProc(Prop); // call original method
end;
end;
end;
end.
I am creating a custom control derived from TCustomControl, for example:
type
TMyCustomControl = class(TCustomControl)
private
FText: string;
procedure SetText(const Value: string);
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Text: string read FText write SetText;
end;
Note, the above is incomplete for purpose of the example to keep it short and simple.
Anyway, in my control I have a Paint event which displays text (from FText field) using Canvas.TextOut.
When my component is added to the Delphi Form Designer (before any user changes can be made to the component) I want the TextOut to display the name of the Component - TButton, TCheckBox, TPanel etc are examples of this with their caption property.
If I try to assign the name of my Component to FText in the constructor it returns empty, eg '';
constructor TMyCustomControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FText := Name; //< empty string
ShowMessage(Name); //< empty message box too
end;
If I change FText := Name to FText := 'Name'; it does output the text to my Component so I do know it is not a problem within the actual code, but obviously this outputs 'Name' and not the actual Component name like MyCustomControl1, MyCustomControl2 etc.
So my question is, how can you get the name of your Component from its constructor event?
The Name property has not been assigned yet when the constructor is running. At design-time, the IDE assigns a value to the Name property after the component has been dropped onto the Designer, after the control's constructor has exited. At runtime, the Name property is set by the DFM streaming system instead, which is also invoked after the constructor has exited.
Either way, the TControl.SetName() property setter validates the new value, and then sets the new value to the control's Text property to match if the current Text value matches the old Name value and the control's ControlStyle property includes the csSetCaption flag (which it does by default). When the Text property changes for any reason, the control automatically sends itself a CM_TEXTCHANGED notification. You can have your control catch that message and call Invalidate() on itself to trigger a new repaint. Inside of your Paint() handler, simply draw the current Name as-is, whatever value it happens to be. If it is blank, so be it. Don't try to force the Name, let the VCL handle it for you normally.
I believe the proper way to handle this is to use the inherited Text or Caption property of TCustomControl, and to make sure that the csSetCaption ControlStyle is set.
To apply the name you may override TComponent.Loaded method.
But i don't think You should copy Name to Text. Those are semantically separate properties and adding unexpected binding to them would hurt you some day.
Rather WMPaint method should check if the Text is empty and then render Name then, but the very property of Text should not be changed.
procedure TMyComponent.WMPaint; message WM_Paint; var InternalCaption: string;
begin
....
InternalCaption := Self.Text;
If InternalCaption = '' then InternalCaption := Self.Name;
If InternalCaption = '' then InternalCaption := Self.ClassName;
....
Self.Canvas.OutText(InternalCaption);
If anything - you should keep properties separated just for the simple reason that Name := 'AAA'; Name := 'BBB'; should not make Text and name out of sync. And with your approach 1st statement would settle the Text and the second would make old Name still displayed after the actual name changed.
Un easy way is to override the method SetName:
TMyCaptionString = type of WideString;
TMyLabel = class(TCustomControl)
private
FCaption: TMyCaptionString;
FCaptionAsName: Boolean;
procedure SetCaption(Value: TMyCaptionString);
protected
procedure SetName(const NewName: TComponentName); override;
public
constructor Create(AOwner: TComponent); override;
property Caption: TMyCaptionString read FCaption write SetCaption;
end;
implementation
constructor TMyLabel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque, csReplicatable,csSetCaption];
FCaptionAsName := (csDesigning in ComponentState) and not (csReadingState in ControlState);
...
end;
procedure TMyLabel.SetName(const NewName: TComponentName);
begin
if FCaptionAsName then
begin
FCaptionAsName := FCaption = Name;
FCaption := NewName;
invalidate;
end;
inherited SetName(NewName);
end;
procedure TMyLabel.SetCaption(Value: TMyCaptionString);
begin
if FCaption <> Value then
begin
FCaption := Value;
Invalidate;
FCaptionAsName := False;
end;
end;
I needed my own variable for the Caption poreprty, because I want to use widestring instead unicode and to write a custom Property editor. Sorry that i'm writing in old topic, but i hope this will helpfull.
I am sure that I got a good answer to my previous question because I have previously had a great deal of help on other questions from the guys who posted there.
But I am obviously doing something wrong, because when I copy the example code what the object inspector shows me for the MyProp property is a single text input field. I was expecting to see something that looks like the Font property, with Pitch, font family, etc i.e I expect to see a tree structure but I don't see the Color, Height or Width properties of the MyProp property.
Any ideas? Again, I copied that code exactly.
Edit: I forgot to mention (in this question) that I am using TMS scripter pro, which allows users to design forms at run time and provides its own object inspector, but that is probably derived from standard Delphi stuff, I guess.
Anyway, it appears that I am too dumb to code Delphi as I simply can't get this to work.
Edit: TMS assure me that if the class with "sub-properties) is descended from TPresistent then it will appear in the object inspector with sub-properties, just like Font, Anchors, etc
When I use this code, the "Warning" property appears as a text field in the object inspector and has no sub-properties
unit IntegerEditBox;
// An edit box which only accepts integer values and warns if the value is not in a certain range
interface
uses
SysUtils, Classes, Controls, StdCtrls,
EditBox_BaseClass;
type
TWarning = Class(TPersistent)
private
FWarningBelowValue : Integer;
FWarningAboveValue : Integer;
FWarningEmailTo : String;
FWarningSmsTo : String;
published
property WarningBelowValue : Integer read FWarningBelowValue write FWarningBelowValue;
property WarningAboveValue : Integer read FWarningAboveValue write FWarningAboveValue;
property WarningEmailTo : String read FWarningEmailTo write FWarningEmailTo;
property WarningSmsTo : string read FWarningSmsTo write FWarningSmsTo;
end;
TIntegerEditBox = class(TEditBox_BaseClass)
private
FWarning : TWarning;
procedure WriteValue(const newValue : Integer);
protected
// The new property which w/e introduce in this class
FValue : Integer;
public { Public declarations }
Constructor Create(AOwner: TComponent); override; // This constructor uses defaults
property Text;
published { Published declarations - available in the Object Inspector at design-time }
property Hint;
// Now our own properties, which we are adding in this class
property Value : Integer read FValue write WriteValue;
property Warning : TWarning read FWarning write FWarning ;
end; // of class TIntegerEditBox()
procedure Register;
implementation
uses
Dialogs;
procedure Register;
begin
RegisterComponents('Standard', [TIntegerEditBox]);
end;
Constructor TIntegerEditBox.Create(AOwner: TComponent);
begin
inherited; // Call the parent Create method
Hint := 'Only accepts a number|Only accepts a number'; // Tooltip | status bar text
Mandatory := True;
Value := 0;
Text := IntToStr(Value);
end;
procedure TIntegerEditBox.WriteValue(const newValue : Integer);
begin
Text := IntToStr(newValue);
end;
end.
The original version of the demo code neglected to create an instance of the property object.
constructor TMyControl.Create(AOwner: TComponent)
begin
inherited;
FMyProp := TCustomType.Create;
end;
Don't forget to free it in the destructor.
Remy's comment on that answer points out that the property needs to be assigned differently. The property's write accessor shouldn't write directly to the field. Instead, it should have a setter method that works like this:
procedure TMyControl.SetMyProp(const Value: TCustomType);
begin
FMyProp.Assign(Value);
end;
That also highlights the requirement that the property class's Assign method be implemented, or else you'll get strange error messages like "Cannot assign a TCustomType to a TCustomType." A simple implementation could go like this:
procedure TCustomType.Assign(Source: TPersistent);
begin
if Source is TCustomType then begin
Color := TCustomType(Source).Color;
Height := TCustomType(Source).Height;
Width := TCustomType(Source).Width;
end else
inherited;
end;
I'm to code a TExpandedShape class inherited from TShape. TExpandedShape must act like TShape and be able to draw extra shapes: Polygon and Star.
Here is my code
unit ExpandedShape;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, Windows;
type
TExpandedShapeType = (
stRectangle, stSquare, stRoundRect, stRoundSquare, stEllipse, stCircle,
stPolygon,
stStar
);
TExpandedShape = class(TShape)
private
FShape: TExpandedShapeType;
FEdgeCount: integer;
procedure SetShape(const Value: TExpandedShapeType);
procedure SetEdgeCount(const Value: integer);
public
procedure Paint; override;
published
property Shape : TExpandedShapeType read FShape write SetShape;// default stPolygon;
property EdgeCount : integer read FEdgeCount write SetEdgeCount default 5;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Course', [TExpandedShape]);
end;
// TExpandedShape
procedure TExpandedShape.Paint;
begin
case Shape of
stStar : begin {Draw Star}
end;
stPolygon : begin {Draw Polygon}
end;
else begin
{It is supposed to draw Circle, Rectangle etc, but it does not}
inherited;
end;
end;
end;
procedure TExpandedShape.SetEdgeCount(const Value: integer);
begin
FEdgeCount := Value;
Repaint;
end;
procedure TExpandedShape.SetShape(const Value: TExpandedShapeType);
begin
FShape := Value;
Repaint;
end;
end.
So, what is wrong?
IMO TShape.Paint checks private value like FShape in case section and then decides what to draw. When inherited Paint method is called in my code it checks FShape value sees default 0 value [stRectangle] in there and draws it.
PS: I did solve it with blackmagic way using Shape1 property instead of Shape one and if Shape1 value is not stPolygon or stStar i do like this: begin Shape := TShapeType(Shape1); inherited end; But this option is not really an option. I need a good short nice-looking one.
add this inherited line before your inherited....
inherited Shape := TShapeType(Shape); // ** add this line **
inherited;
Here in my web you can find an article about PlugIns in Delphi.
The sample code of the article implement a descendant class of TShape. All the code is included. You can download and see the code of class.
Another descendant classes implement figures lile Stars, Arrows,...
Here you can see some figures descendant of TShape implemented.
Neftalí
P.D: Excuse-me for mistakes with english.