79098964

Date: 2024-10-17 16:09:04
Score: 2.5
Natty:
Report link

Disclaimer: I've borrowed from @david-heffernan's answer, @lu-rd's comments on that answer, and from this this page which writes about the with trick.

The example below works in Delphi 12.1.

Background (or a long rant; just skip to the answer): after migrating a project from Delphi 7 to Delphi 12.1, it was discovered that where TDateTimePicker.Date was used, the time portion was included in the resultant TDateTime, but at some point (maybe even in Delphi 12.1, I don't know) this was changed to strip out the time portion, returning only the date in the resultant TDateTime. An urgent fix was needed. It was decided that changing potentially hundreds of instances of Date to DateTime was too error-prone given the time constraint. To plug in a great annoyance I have with Delphi is that now that it has LSP, why haven't they prioritised the ability to find all references for a given symbol accurately? The existing Refactoring menu is deprecated and broken and it sucks that I have to repeatedly resort to class helpers and hacks (like using Detours library's trampolines) to avoid making error-prone mass changes - something I could do with a few clicks and keystrokes in C# (and could have done many years ago). I suppose I could add a copy of Vcl.ComCtrls.pas into the project, rename the existing Date property to something like DateBlahBlahBlah, write an automation script that performs a compile, waits for the error, sends keystokes to the editor or edits the file where DateBlahBlahBlah was found and changes it to DateTime, but I am not going to do that (yet :D).

The fix I went for involved overriding the behaviour of:

function GetDate: TDate;

Which is in:

TCommonCalendar = class(TWinControl)

Which is in:

Vcl.ComCtrls.pas

I've done the work in a separate unit that was simply added to the project. It's pasted in its entirety below. Notice that I commented out another verison of TCommonCalendarHelper.GetGetDateAddress which shows another way to get private method's address using with; I went with what looks like a simpler/shorter version. Also included in the code below is a bit help access TCommonCalendar.DateTime protected property.

The whole unit:

unit D12DateTimePickerFix;

interface

{ Fix for TDateTimePicker.Date no longer also including the time, and TDateTimePicker.Time no longer including the date.

In Delphi 7, getting TDateTimePicker.Date (TDateTime) included the time portion of TDateTime, as shown below:

function TCommonCalendar.GetDate: TDate;
begin
  Result := TDate(FDateTime);
end;

Even though there is a cast, it's only symbolic, since TDate is TDateTime.

In Delphi 12.1 (or earlier versions), they changed it so the time portion is stripped out:

function TCommonCalendar.GetDate: TDate;
begin
  Result := TDate(DateOf(FDateTime));
end;

Ths fix involves patching TCommonCalendar.GetDate method, or rather, "hooking" into it so our own method is called instead.

The Detours library is utilised again, which is currently needed for a BDE fix. In the future, a search is needed for
all the instances where TDateTimePicker.Date is used, and replaced with DateTime. Let's wait until Delphi's "Refactoring"
features are not in a "deprecated" state.

Similarly, TDateTimePicker.Time no longer includes the date.

In Delphi 7 the code is:

function TDateTimePicker.GetTime: TTime;
begin
  Result := TTime(FDateTime);
end;

In Delphi 12.1, the code is:

function TDateTimePicker.GetTime: TTime;
begin
  Result := TTime(TimeOf(FDateTime));
  if (Result = 0) and ([csWriting, csDesigning] * ComponentState <> []) then
    Result := TTime(FDateTime);
end; }

implementation

uses
  ComCtrls,
  DDetours  //need this library for easy injecting/hooking/trampolining (like with madCodeHook)
  ;

//helper class is needed to get an address of a private method
type
  TCommonCalendarHelper = class helper for TCommonCalendar
    function GetGetDateAddress: Pointer;
  end;
  TDateTimePickerHelper = class helper for TDateTimePicker
    function GetGetTimeAddress: Pointer;
  end;

{ TCommonCalendarHelper }

function TCommonCalendarHelper.GetGetDateAddress: Pointer;
begin
  Result := @TCommonCalendar.GetDate;
end;

//alternative way to access a private method using a "with" trick
{function TCommonCalendarHelper.GetGetDateAddress: Pointer;
var
  _GetDateMethod: function: TDate of object;
begin
  with Self do _GetDateMethod := GetDate;
  Result := TMethod(_GetDateMethod).Code;
end;}

{ TDateTimePickerHelper }

function TDateTimePickerHelper.GetGetTimeAddress: Pointer;
begin
  Result := @TDateTimePicker.GetTime;
end;

//the rest of the code below relates to using the Detours library to "hijack" the original GetDate and GetTime methods and use my own methods instead, which demonstrates my use-case in full
var
  GetDate_Old: function(const _Self): TDate = nil;
  GetTime_Old: function(const _Self): TTime = nil;

type
  TCommonCalendarAccess = class(TCommonCalendar);  //need this to access the protected DateTime property

function GetDate_New(const _Self): TDate;
begin
  //var Self: TCommonCalendarAccess := @_Self; Result := Self.DateTime;
  Result := TDate(TCommonCalendarAccess(@_Self).DateTime);  //restore Delphi 7 behaviour
end;

function GetTime_New(const _Self): TTime;
begin
  Result := TTime(TDateTimePicker(@_Self).DateTime);  //restore Delphi 7's behaviour
end;

initialization
  //intercept the two methods in Vcl.ComCtrls.pas
  @GetDate_Old := InterceptCreate(TCommonCalendar.GetGetDateAddress, @GetDate_New);
  @GetTime_Old := InterceptCreate(TDateTimePicker.GetGetTimeAddress, @GetTime_New);
finalization
  //undo intercepts
  InterceptRemove(@GetDate_Old);
  InterceptRemove(@GetTime_Old);
end.
Reasons:
  • RegEx Blacklisted phrase (2): urgent
  • Long answer (-1):
  • Has code block (-0.5):
  • Contains question mark (0.5):
  • User mentioned (1): @david-heffernan's
  • User mentioned (0): @lu-rd's
  • Low reputation (0.5):
Posted by: TByte