Forum > Designer
How can I register a TField descendant in the IDE?
(1/1)
DavidAM:
I have written a TField descendant class (actually a TDateTimeField descendant). I created a Design-time package for it, and installed it, recompiling the IDE. It is the only thing in the package - 1 unit file, 1 class definition.
I added the package to my project and tried to use this new class. I have a TSqlQuery component on a form with the Dataset properly defined. (The form is working 100% before adding this class). I expected to be able to click a TDateTimeField in the Object Inspector, right-click and select "Change Class", then be able to change the field's class to my new TDateTimeField (descendant) class. The new class does not appear as a choice.
I added the new field's unit to the uses clause of the form, I changed the class references in the type definition, then opened the form's .lfm file and changed the references there. Then I rebuilt the application (Clean up and Build). The new class works 100% from code. However, I cannot use "Change Class" in the Object Inspector to switch a field to my new class. I can edit the one property I added to the class in the Object Inspector.
Is there some way to register the TField descendant so it is available to the Object Inspector's "Change Class" menu choice?
This is the entire unit file.
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit utmadcustomfields; { This file defines a custom TDateTimeField to override the standard one. The (initial) purpose is to select a DateTime from the Database - which is in UTC Time - and use it as a Local Time value. I decided to try this approach for the experience of overriding a registered class. I tried reintroducing GetData() - all GetAsXXXXX methods ultimately call it - but the Ancestor class calls still go to the Acnestor's implementation. So, I am overriding the GetAsXXXXX methods that TDateTime overrides: GetAsDateTime GetAsFloat - calls GetAsDateTime - no overide necessary GetAsString - calls GetText - copied implementation from fields.inc (with changes) GetAsVariant - returns a TDateTime or Null SetAsDateTime SetAsFloat - calls SetAsDateTime - no overide necessary SetAsString - calls StrToDateTime - SetVarValue - calls SetAsDateTime - no overide necessary} {$mode objfpc}{$H+} interface uses Classes, SysUtils, DB, DateUtils; type { TMadUtcDateTimeField } { This class behaves just like TDateTimeField if ShowAsLocalTime is False (default). When ShowAsLocalTime is True, the stored data is treated as a UTC time and is converted To/From LocalTime. } TMadUtcDateTimeField = class(TDateTimeField) protected FShowAsLocalTime: Boolean; function GetAsDateTime(): TDateTime; override; procedure GetText(var AText: string; ADisplayText: Boolean); override; function GetAsVariant(): variant; override; procedure SetAsDateTime(aValue: TDateTime); override; procedure SetAsString(const AValue: string); override; published { If True, the source data is considered to be a UTC datetime value. GetAsXXXXXXX will convert it and return a Local time. SetAsXXXXXXX will convert the provided value and store as a UTC time. } property ShowAsLocalTime: Boolean read FShowAsLocalTime write FShowAsLocalTime; end; procedure Register; implementation procedure Register;begin RegisterClass(TMadUtcDateTimeField);end; { TMadUtcDateTimeField } { Return the current value as a DateTime value. If SourceIsUTC is True, the value is considered to be a UTC value and is (converted to and) returned as a Local value }function TMadUtcDateTimeField.GetAsDateTime(): TDateTime;begin Result := inherited GetAsDateTime(); if (FShowAsLocalTime) then Result := UniversalTimeToLocal(Result);end; { Copied from fields.inc - with changes}procedure TMadUtcDateTimeField.GetText(var AText: string; ADisplayText: Boolean);var R : TDateTime; F : String;begin If Not GetData(@R,False) then AText:='' else begin // MAD - convert to Local if (FShowAsLocalTime) then R := UniversalTimeToLocal(R); If (ADisplayText) and (Length(Self.DisplayFormat)<>0) then F:=Self.DisplayFormat // MAD else Case DataType of ftTime : F:=DefaultFormatSettings.LongTimeFormat; // MAD ftDate : F:=DefaultFormatSettings.ShortDateFormat; // MAD else F:='c' end; AText:=FormatDateTime(F,R); end;end; { inherited returns a TDateTime or Null. Convert if it is not Null }function TMadUtcDateTimeField.GetAsVariant(): variant;begin Result := inherited GetAsVariant(); if ((FShowAsLocalTime) and (Result <> Null)) then Result := UniversalTimeToLocal(Result);end; { Set the stored value as a DateTime value. If SourceIsUTC is True, the provided value is considered to be a Local Time and is converted to UTC. }procedure TMadUtcDateTimeField.SetAsDateTime(aValue: TDateTime);begin if (FShowAsLocalTime) then aValue := LocalTimeToUniversal(aValue); inherited SetAsDateTime(aValue);end; { inherited sets the value, then we convert the Value if FShowAsLocalTime is True }procedure TMadUtcDateTimeField.SetAsString(const AValue: string);begin inherited SetAsString(AValue); if (AValue <> '') then if (FShowAsLocalTime) then Self.Value := LocalTimeToUniversal(Self.Value);end; end.
Environment:
Operating System: Win64
Processor Architecture: x86_64
Lazarus Version: 3.2.0.0
WidgetSet: win32
Compiler Version: 3.2.2
marcov:
I'm not really a designtime expert, but afaik the .pas file of the package should pass the register procedure together with the package name using registerpackage ?
DavidAM:
Yeah, I checked on that. The RegisterPackage call and the RegisterUnit call are in the Package Source file that is automatically generated by Lazarus. It looks like that is all correct. The file I pasted in my post is a separate unit file in the package and is (I believe) properly referenced in the RegisterUnit call.
Navigation
[0] Message Index