Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Override a published property ?

18 views
Skip to first unread message

nospam

unread,
Jul 16, 2008, 1:06:50 PM7/16/08
to
Is it possible to override a published property ?

for example Tlistview has an 'items' property of Tlistitems datatype.

I want to write a TmyListview = class(Tlistview) component and publish an
'items' property of type Tstrings replacing the previous property.

Delphi compiles this fine, but the IDE does not seem to like it.


Please avoid answers starting with 'Why', i'm not a philosopher, i already
know there are other ways to do it, starting with renaming the new property
to 'Zitems' instead if 'items' .... but that's not the question here. The
question is : is overriding of a published property allowed or not in delphi
2007 ?

Peter Below (TeamB)

unread,
Jul 16, 2008, 1:54:35 PM7/16/08
to
nospam wrote:

You can do it but you will not get automatic design-time support of you
keep the name but change the properties type. The IDE will not be able
to find a suitable property editor for your property.

--
Peter Below (TeamB)
Don't be a vampire (http://slash7.com/pages/vampires),
use the newsgroup archives :
http://www.tamaracka.com/search.htm
http://groups.google.com

Marc Rohloff [TeamB]

unread,
Jul 16, 2008, 1:43:48 PM7/16/08
to
On Wed, 16 Jul 2008 19:06:50 +0200, nospam wrote:

> Is it possible to override a published property ?

Yes.

Have you tried it using 'zitems' as the property name just to make
sure there are no other issues? What error do you get? Can you post
your code? Why?

--
Marc Rohloff [TeamB]
marc -at- marc rohloff -dot- com

Remy Lebeau (TeamB)

unread,
Jul 16, 2008, 2:50:17 PM7/16/08
to

"nospam" <nos...@stupidspammers.com> wrote in message
news:487e2aa9$1...@newsgroups.borland.com...

> I want to write a TmyListview = class(Tlistview) component and
> publish an 'items' property of type Tstrings replacing the previous
> property.

Then use a TListBox instead. It already has a TStrings-based Items
property.


Gambit


nospam

unread,
Jul 17, 2008, 2:44:23 AM7/17/08
to
Hi Remy

You are near from the 'reason why' i want to do this.

We started to write our application in delphi 1 and used Tlistbox in a
standard form to display ours lists of data. this form is called everywhere
whena user searches something.

It was a supercharged Tlistbox with Tabulation feature using #9.

Now i want to use Tlistview instead to provide modern visual expêrience to
our users and columns/headers/sorting features.

but everywhere in the code we call the form and populate the Tlistbox with
add('mytext'+#9+'hello'+#9+'world') and get the result by extracting the
data between the #9

So if i can create a Tlistview with a Tstrings items property, and populate
the inherited TlistItems from the Tstrings ... no need to change the code
everywhere in the app.

"Remy Lebeau (TeamB)" <no....@no.spam.com> a écrit dans le message de
news:487e...@newsgroups.borland.com...

nospam

unread,
Jul 17, 2008, 3:29:35 AM7/17/08
to
Hi Marc, Peter, Remy & TeamB

I'll submit here my 'work in progress' code for all of you.

To test create an empty project, add a TaTAlistview, and in the onshow event
of the form input :

AtaListView1.Items.AddTitle('A'+#9+'B'+#9+'C');
AtaListView1.Items.Add('PIM'+#9+'PAM'+#9+'POUM');

be prepared for heavy AV when accessing to the items property in the
property editor

here is the comp code :

unit AtaListView;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Tblstata, ComCtrls;

type
TSepChamp = (Tabulation, Tube, AnteSlash);

TAtaListView = class;

TLVstrings = class(TstringList)
private
{ Private declarations }
Fowner: TAtaListView;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TAtaListView);
function Add(const S: string): Integer; override;
procedure AddTitle(const S: string);
procedure Clear; override;
procedure Delete(Index: Integer); override;
published
{ Published declarations }
end;

TAtaListView = class(TlistView)
private
{ Private declarations }
FTabs : array[1..MaxTabs] of integer;
ChampSep : TSepChamp;
FStrings: TLVstrings;
procedure SetTabs(Value : string);
function GetTabs : string;
procedure SendTabs;
protected
{ Protected declarations }
procedure CreateWnd; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
function RenvoiSep: Char;

published
{ Published declarations }

property TabPercentages : string read GetTabs write SetTabs;
property SeparChamp : TSepChamp read ChampSep write ChampSep default
Tabulation;
property Items: TLVstrings read FStrings write FStrings stored True;
end;


implementation

const
MaxTabs = 20;

type
EOrderException = class(Exception);


function StrCount(SubString, aString: string): integer;
begin
Result := 0;
while pos(SubString, aString)>0 do
begin
delete(aString,pos(SubString, aString),length(SubString));
inc(result);
end;
end;


function StrExtract(Chaine: String; position: LongInt; Separateur: String;
DefaultResult: string=' '): String;
var
counter, ordre, start: integer;
begin
Result := DefaultResult;
ordre := 0;
if
copy(chaine,length(chaine)-length(separateur)+1,length(separateur))<>separateur
then
chaine := chaine + separateur;
start := 1;
for counter := 1 to length(chaine) do
begin
if copy(Chaine, counter, length(Separateur))=Separateur then
begin
inc(ordre);
if ordre=position then
begin
Result := copy(Chaine, start, counter-start);
break;
end;
start := counter+length(Separateur);
end;
end;
end;


function TAtaListView.RenvoiSep: Char;
begin
Case ChampSep of
Tube: Result := '|';
AnteSlash: Result := '\';
else
Result := #9;
end;
end;

constructor TAtaListView.Create(AOwner: TComponent);
begin
inherited;
FStrings := TLVstrings.Create(Self);
Self.RowSelect := True;
Self.ViewStyle := VsReport;
Self.SortType := StText;
Self.ReadOnly := True;
end;

destructor TAtaListView.Destroy;
begin
FStrings.Free;
inherited;
end;

procedure TAtaListView.CreateWnd;
begin
inherited CreateWnd;
SendTabs;
end;


function TAtaListView.GetTabs : string;
{translate FTab array into a string}
var
Tab, I : integer;
begin
Result := '';
for I := 1 to MaxTabs do
begin
Tab := FTabs[I];
if I > 1 then
if Tab = 0 then Break
else Result := Result + ', ';
Result := Result + IntToStr(Tab);
end;
end;

function Trim(const S : String) : String;
{Trims leading and trailing spaces, tabs, and control chars from string}
var
I, Len : Integer;
begin
Result := S;
while (Length(Result) > 0) and (Result[Length(Result)] <= ' ') do
SetLength(Result,Length(Result)-1); {remove trailing junk}

if Length(Result) > 0 then
begin
I := 1;
while Result[I] <= ' ' do Inc(I); {count leading junk}
if I>1 then
begin
Len := Length(Result) -I+1; {figure new length}
Move(Result[I], Result[1], Len);
SetLength(Result,Len);
end;
end;
end;

procedure TAtaListView.SetTabs(Value : string);
var
I, J, Last : integer;
L : LongInt;
Done : boolean;
Tmp : array[1..MaxTabs] of Integer;

function EvalSubStr : LongInt;
var
S : string[15];
begin
S := Trim(Copy(Value, 1, J-1));
System.Delete(Value, 1, J);
Result := StrToInt(S);
end;

begin
FillChar(Tmp, Sizeof(Tmp), 0);
I := 1;
Done := False;
Last := -1;

while not Done and (I <= MaxTabs) do
begin
Value := Trim(Value);
J := Pos(',', Value);

if J > 0 then L := EvalSubStr
else
begin
J := Pos(' ', Value);

if J > 0 then L := EvalSubStr
else
begin
L := StrToInt(Value);
Done := True;
end;
end;

if (L < 0) or (L > 200) then
Raise EOrderException.Create('Tab percentage values must be '+
'between 0 and 200');

Tmp[I] := L;

if L <= Last then
Raise EOrderException.Create('Tab percentage values must be in '+
'increasing order');
Last := L;
Inc(I);
end;
Move(Tmp, FTabs, Sizeof(Tmp)); {only happens if no exception}
SendTabs;
end;

procedure TAtaListView.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var Tmp : integer;
begin
Tmp := Width;
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
if Tmp <> AWidth then SendTabs;
end;

procedure TAtaListView.SendTabs;
var
Tabs : array[1..MaxTabs] of integer;
i: integer;
begin
if HandleAllocated then
begin
i := 1;
while (i <= MaxTabs) and (FTabs[i] > 0) do
begin
Tabs[i] := round(Width*LongInt(FTabs[i]) div 100);

if i<=Self.columns.count then Self.columns[i-1].Width := Tabs[I];

Inc(i);
end;
Invalidate;
end;
end;

{ TLVstrings }

constructor TLVstrings.Create(AOwner: TAtaListView);
begin
FOWner := AOwner;
end;

procedure TLVstrings.Clear;
begin
inherited Clear;
Tlistview(FOwner).Items.Clear;
end;

procedure TLVstrings.Delete(Index: Integer);
begin
inherited Delete(Index);
if Tlistview(FOwner).Items.Count>0 then
Tlistview(FOwner).Items.Delete(Index);
end;

function TLVstrings.Add(const S: string): Integer;
var i: integer;
aItem: TlistItem;
begin
result := inherited add(S);
for i := 0 to StrCount(FOWner.RenvoiSep, S) do
begin
if i>Fowner.Columns.Count-1 then Fowner.Columns.Add;
if i=0 then
begin
aItem := Tlistview(FOwner).Items.Add;
aItem.Caption := StrExtract(S, i+1, FOwner.RenvoiSep);
end
else aItem.SubItems.Add(StrExtract(S, i+1, FOwner.RenvoiSep));
end;
end;

procedure TLVstrings.AddTitle(const S: string);
var i: integer;
begin
for i := 0 to StrCount(FOWner.RenvoiSep, S) do
begin
if i>Fowner.Columns.Count-1 then Fowner.Columns.Add;

Fowner.Columns[i].Caption := StrExtract(S, i+1, FOwner.RenvoiSep);
end;
end;

end.

"Marc Rohloff [TeamB]" <ma...@nospam.marcrohloff.com> a écrit dans le message
de news:7sy9vyws...@dlg.marcrohloff.com...

nospam

unread,
Jul 17, 2008, 3:31:50 AM7/17/08
to
Hi Peter,

It's not exactly the behaviour i see, in fact the IDe finds the right editor
... but fails to load/write the properties and still uses the inherited
previous properties.

See the sample i sent to marc in the same thread

Cheers

"Peter Below (TeamB)" <no...@nomail.please> a écrit dans le message de
news:xn0fsr94...@newsgroups.borland.com...

nospam

unread,
Jul 17, 2008, 3:41:31 AM7/17/08
to
Hi again Marc

i forgot to answer your question... yes i tried with zitem, bnefore creating
the topic, everything is fine

Cheers

"Marc Rohloff [TeamB]" <ma...@nospam.marcrohloff.com> a écrit dans le message
de news:7sy9vyws...@dlg.marcrohloff.com...

nospam

unread,
Jul 17, 2008, 4:06:38 AM7/17/08
to
OK You don't have TblsAta unit.

it's not needed for the sample, remove it from the uses and move

const
MaxTabs = 20;

up at the top of the interface section.


Sorry, i didn't notice it before...


"nospam" <nos...@stupidspammers.com> a écrit dans le message de
news:487e...@newsgroups.borland.com...

Marc Rohloff [TeamB]

unread,
Jul 17, 2008, 11:04:35 AM7/17/08
to
On Thu, 17 Jul 2008 09:29:35 +0200, nospam wrote:


I didn't run your code, but offhand:


> property Items: TLVstrings read FStrings write FStrings stored True;

is incorrect. It should be

property Items: TLVstrings read FStrings write FStrings stored True;

should be:
property Items: TLVstrings read FStrings write SetStrings
stored True;
procedure TAtaListView.SetStrings(value:TLVStrings);
begin
fStrings.Assign(value);
end;
and you may also need to register a property editor, you could also
make your published property of type TStrings even though it is really
a subclass (this is what something like TListbox does).


Some other points:
StrCount: you should use PosEx instead of continually modifying your
string.
Trim: There are already Trim or TrimLeft functions available with
Delphi.
TLVStrings.Create should call inherited.

nospam

unread,
Jul 17, 2008, 11:58:28 AM7/17/08
to
hi Peter

>You can do it but you will not get automatic design-time support

well i could live at without design support of the items property. This way
it seems to work BUT...

In fact, my worst worry is about Codegear removing the current possibility
of property overriding from the compiler in the futurejust because they
don't consider it usefull.

And i find nowhere in the help or on the internet anything speaking of
'published property overriding' so i don't know if i can count on it in the
future...

What if delphi 2008 suddendly displays an error and says ''published
property overriding is forbidden' or behaves differently...

Do you think someone of you could ask Codegear Dev Team if 'published
property overriding' is really something supported and if it is really
expected to work ?

Thank you

"Peter Below (TeamB)" <no...@nomail.please> a écrit dans le message de
news:xn0fsr94...@newsgroups.borland.com...

nospam

unread,
Jul 17, 2008, 12:24:33 PM7/17/08
to
Hi Marc,

>TLVStrings.Create should call inherited.
You're right. Done.

but this does not change anything since the only implementation on the
tstringlist create method is in the 'Tobject' ancestor with
constructor TObject.Create;
begin
end;

>Some other points:
>StrCount: you should use PosEx instead of continually modifying your
>string.
>Trim: There are already Trim or TrimLeft functions available with
>Delphi.

Your right again, but as explained to remy later in the thread i'm working
on a delphi app created in 1988 with delphi 1, and who upgraded with delphi
2,3,4,5,6,7,2007 and some of the old code is still there, the app is still
living and we are too busy writing new features to stop and rewrite the old
code that is working and doing the job good enought even if not beautifull.

To create the sample i had to extract parts of the 'old code' and just
pasted it to be quick.


As asked to Peter my worry is to use a feature that is not expected to exist
by Codegear ... i would like an official opinion on 'published property
overriding' to be sure i'll be supported in the future. I'm worryed because
i cannot find anything about it in the help or on the internet so i was
perhaps just lucky to make it partially work ?

if i move my property TLVstring to public instead of published, the ancestor
items as Tlistview re-appears at design time, and my TLVstring.items is
used at runtime without problems ... this behaviur is enought for me... but
i don't like to be just lucky ... i prefer be sure of what i do.

best regards


Marc Rohloff [TeamB]

unread,
Jul 17, 2008, 2:02:12 PM7/17/08
to
On Thu, 17 Jul 2008 18:24:33 +0200, nospam wrote:

Did you try the change I suggested to SetStrings? This is almost
guaranteed to cause you AVs. I would also suggest that you look at how
some of the other controls implement their Strings properties
(TCombobox, TTabControl), they all use a very similar pattern which
should work for you as well.

nospam

unread,
Jul 18, 2008, 4:33:11 AM7/18/08
to
I'm investigating this, thats why i did not mention the point in my reply.
Thank you for your help.

As said to Peter in the same thread, a 'public' items property is enough
for me, i don't really need it to be published, it's only that when i saw
that the ide could not handle the 'published' items i started to doulbt
about the usage. But my sample actually works without AV if you move the
items property to public. You'll only get AV if you set it to
'published'.But well, thats why sample are made ... to be tested.

But as said, what really interrests me is someone provide me a link to
delphi help where it is specified that a component property (public or
published) can be overrident an the datatype changed. methods have the
'override' flag, but properties do not, it's just implicit and should be
documented somewhere. What could also help is a proof in VCL source code
that Codegear is actually doing it. That way i could be sure future version
of delphi will still allow it. But, if it is written nowhere ... Codegear
can change the behaviour of the compiler anytime or remove the feature,
that's why i prefer use documented features.

Best regards

"Marc Rohloff [TeamB]" <ma...@nospam.marcrohloff.com> a écrit dans le message

de news:1kcyjwon...@dlg.marcrohloff.com...

nospam

unread,
Jul 21, 2008, 6:14:56 AM7/21/08
to
> Did you try the change I suggested to SetStrings? This is almost
> guaranteed to cause you AVs. I would also suggest that you look at how
> some of the other controls implement their Strings properties
> (TCombobox, TTabControl), they all use a very similar pattern which
> should work for you as well.
>
> Marc Rohloff [TeamB]

You where right Marc !!!!

Looks like the DFM streaming system requires and uses the SetStrings Method.

With the SetStrings, no more AV, il can publish my re-type items property
and the editor is correctly replaced by the IDE and the strings are correcly
stored/read in the form. It works like a charm. Big thank you again ! I'm
sorry i doubted it could work.

I just feel more like a magician experimenting undocumented features that a
programmer ;-) Again, i would really like to have official documentation
about this.

Cheers, Have a nice day. and here's the final source code :


unit AtaListView;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls, ComCtrls;

const
MaxTabs = 20;

type


TSepChamp = (Tabulation, Tube, AnteSlash);

TAtaListView = class;

TLVstrings = class(TStringList)

protected
{ Protected declarations }

published
{ Published declarations }

end;

procedure SetItems(value: TLVstrings);

public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
function RenvoiSep: Char;

published
{ Published declarations }

property TabPercentages : string read GetTabs write SetTabs;
property SeparChamp : TSepChamp read ChampSep write ChampSep default
Tabulation;

property Items: TLVstrings read FStrings write Setitems;
end;


implementation

type
EOrderException = class(Exception);

Self.ShowColumnHeaders := False;

Tmp[I] := L;

procedure TAtaListView.SetItems(value: TLVstrings);
begin
FStrings.Assign(value);
end;

procedure TAtaListView.SendTabs;
var
Tabs : array[1..MaxTabs] of integer;
i: integer;
begin
if HandleAllocated then
begin
i := 1;
while (i <= MaxTabs) and (FTabs[i] > 0) do
begin
Tabs[i] := round(Width*LongInt(FTabs[i]) div 100);

if i<=Self.columns.count then Self.columns[i-1].Width := Tabs[I];

Inc(i);
end;
Invalidate;
end;
end;

{ TLVstrings }

constructor TLVstrings.Create(AOwner: TAtaListView);
begin
inherited create;
FOWner := AOwner;
end;

Fowner.ShowColumnHeaders := True;
end;

end.

0 new messages