There are times when you get painted into a corner. Some times, you paint yourself in, and some times, you get painted in by others. If you do it to yourself, it is much easier to get out by just changing all of the things needed to get out of the jam. Other times, your hands are tied and you can only make changes to specific areas of code, like the implementation section. A couple of reasons for this would be to preserve binary compatbility of a published interface for your framework, or a 3rd party component relies on that dcu compatibility of another 3rd party. Given all of the above, what do you do if you want to add a property to an existing class without changing the interface section of that unit? I came up with the following hack to get this done, but be cautioned, this is definitely not for the squeamish! :)
Let's say you have a setup like the following:
unit uExtenderTypes;
interface
type
TType = class
private
FID: integer;
public
procedure Display;
property ID: integer read FID write FID;
end;
function GetType: TType;
implementation
uses
SysUtils, Dialogs;
var
gblType: TType = nil;
function GetType: TType;
begin
if gblType = nil then
gblType := TType.Create;
Result := gblType;
end;
procedure TType.Display;
begin
ShowMessage(IntToStr(ID));
end;
finalization
if Assigned(gblType) then
FreeAndNil(gblType);
end.
As time passes, you realise you want to only do the ShowMessage some of the time, and to do this you think a CanDisplay property would be perfect on the TType class. But remember, you can't change the interface section. You can add code like this to get things ready (only the changed section is listed here):
{$M+}
type
TDerivedType = class(TType)
private
FCanDisplay: boolean;
published
property CanDisplay: boolean read FCanDisplay write FCanDisplay;
end;
{$M-}
function GetType: TType;
begin
if gblType = nil then
gblType := TDerivedType.Create;
Result := gblType;
end;
procedure TType.Display;
begin
if (Self is TDerivedType) and TDerivedType(Self).CanDisplay then
ShowMessage(IntToStr(ID));
end;
Note that the main changes are to add the new class - derived from the base class - in the implementation section; update the singleton TType return function; and update the Display method to conditionally display the message.
In order to set this property, we will rely on RTTI since callers outside the scope of this unit will have no idea what the TDerivedType is. The code for this would look similar to this:
procedure SetCanDisplay(t: TType; Value: boolean);
begin
if IsPublishedProp(t, 'CanDisplay') then
SetOrdProp(t, 'CanDisplay', ord(Value));
end;
procedure TForm3.btnDerivedClick(Sender: TObject);
var
t: TType;
begin
t := GetType;
t.ID := 30;
SetCanDisplay(t, true);
try
t.Display;
finally
SetCanDisplay(t, false);
end;
end;
Obviously, this technique should only be used as a last result. However, it can get you out of that tight spot for a little while, and the changes are pretty well self-contained so you can do it right when building the next version.