Delphi TDateTimePicker with WeekNumber

This is not about C++ or C# or Geometry but about Delphi.

I used to have a TDateTimePicker in my app showing the week number. This trick is described on several places, e.g. here and (in Dutch) here

However, since Windows 7 (or probably since Windows Vista) this behaves differently, resulting in an ugly calendar where the right side is cut off :-(




The problem was that the actual control (SysMonthCal32) is, since Windows 7, put inside another control (DropDown), which has the same size as the month calendar. So you can enlarge the month calendar, but it only results in things not being displayed. So the parent control (DropDown) should be resized here...

Getting the parent is easy with Windows (GetParent), but it should still work using XP of course. So we check if the parent is really a "DropDown". There might be other ways to do it, but I'm using GetClassName now and that works.

So the adapted solution is here:

procedure TMyForm.BeginDateTimePickerDropDown(Sender: TObject);
const
  MCM_GETMAXTODAYWIDTH  = MCM_FIRST + 21;
var
  Style: LongInt;
  hDTP: THandle;
  r: TRect;
  intTodayWidth: Integer;

  cname: array[0..256] of Char;
begin
  //to get a handle of calendar
  hDTP := DateTime_GetMonthCal((sender as TDateTimePicker).Handle);

  //change a style
  Style := GetWindowLong(hDTP, GWL_STYLE);
  SetWindowLong(hDTP,  GWL_STYLE, Style or MCS_WEEKNUMBERS);

  //now we must change the width for calendar because week numbers shifted all strings
  //1. to get the required rect
  r := Rect(0, 0, 0, 0);
  SendMessage(hDTP, MCM_GETMINREQRECT, 0, Longint(@r));

  //2. to get the maximum width of the "today" string
  intTodayWidth := SendMessage(hDTP, MCM_GETMAXTODAYWIDTH, 0, 0);

  //3. adjust rect width to fit the "today" string
  if intTodayWidth > r.Right then
    r.Right := intTodayWidth;

  // For Win7, the window (class=SysMonthCal32) is automatically inside
  // a parent-window (class=DropDown). Check this. If so, take the parent window.
  // If not so (class=TMainForm), take this window (for XP and lower)
  GetClassName(GetParent(hDtp), cname, sizeof(cname));
  if AnsiSameText(cname, 'DropDown') then
  begin
    hDTP := GetParent(hDTP);

    // To get it perfect (on my machines) is adding this code:
    inc(r.Right, 6);
    inc(r.Bottom, 6);
  end;

  //4. to set new the height and width
  MoveWindow(hDTP, r.Left, r.Top, r.Right-r.Left, r.Bottom-r.Top, true);
end;