Mit Hilfe von https://www.swissdelphicenter.ch/en/showcode.php?id=614 habe ich eine Ableitung vom TDateTimePicker erstellt, welcher auch als Komponente funktioniert.

Sobald ich jedoch die Wochennummern ausblende, wird das Datum, obwohl es als DateFormat := dfLong; immer in Kurzform (01.01.2022) dargestellt.

Wo liegt denn der Fehler in der Komponente?

zusammenfalten · markieren

Delphi-Quellcode:

unit TRM_DateTimePicker;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Controls,
  Forms,
  ComCtrls,
  Dialogs,
  ExtCtrls,
  CommCtrl;

type
  TTRM_DateTimePicker = class(TDateTimePicker)
  private
    { Private declarations }
    FOnMouseLeave: TNotifyEvent;
    FOnMouseEnter: TNotifyEvent;

    FExtraSpaceX: Integer;
    FExtraSpaceY: Integer;

    procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;

    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  protected
    { Protected declarations }
    procedure DoMouseEnter; dynamic;
    procedure DoMouseLeave; dynamic;
    procedure DoDropDown;
  public
    { Public declarations }
    Constructor Create(AOwner: tComponent); Override;
    procedure ShowMonthCalendar;
  published
    { Published declarations }
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;

    property WeekNumbers;
    property WeekExtraSpaceX: Integer Read FExtraSpaceX write FExtraSpaceX;
    property WeekExtraSpaceY: Integer Read FExtraSpaceY write FExtraSpaceY;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('TRM', [TTRM_DateTimePicker]);
end;

{ TRM_DateTimePicker }

Constructor TTRM_DateTimePicker.Create(AOwner: tComponent);
begin
  Inherited Create(AOwner);
  FExtraSpaceX := 12;
  FExtraSpaceY := 12;
  WeekNumbers := True;
  Self.Date := Now;
  DateFormat := dfLong;
end;

procedure TTRM_DateTimePicker.ShowMonthCalendar;
begin
  MonthCal_SetCurrentView(CalendarHandle, MCMV_YEAR);
end;

procedure TTRM_DateTimePicker.CMMouseEnter(var msg: TMessage);
begin
  DoMouseEnter;
end;

procedure TTRM_DateTimePicker.CMMouseLeave(var msg: TMessage);
begin
  DoMouseLeave;
end;

procedure TTRM_DateTimePicker.CNNotify(var Message: TWMNotify);
begin
  if Message.NMHdr.code = DTN_DROPDOWN then
  begin
    if Self.WeekNumbers then
      DoDropDown;
  end;
  inherited;
end;

procedure TTRM_DateTimePicker.DoMouseEnter;
begin
  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
end;

procedure TTRM_DateTimePicker.DoMouseLeave;
begin
  if Assigned(FOnMouseLeave) then
    FOnMouseLeave(Self);
end;

procedure TTRM_DateTimePicker.DoDropDown;
const
  MCM_GETMAXTODAYWIDTH = MCM_FIRST + 21;
var
  Style: LongInt;
  hDTP: THandle;
  r: TRect;
  intTodayWidth: Integer;

  cname: array [0 .. 256] of Char;
begin

  inherited;

  // to get a handle of calendar
  hDTP := DateTime_GetMonthCal(Self.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, WeekExtraSpaceX);
    inc(r.Bottom, WeekExtraSpaceY);
  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;

end.

LG Mathias

Ich beantworte mir selbst meine Frage, habe es gerade bemerkt.

Das Property WeekNumbers hatte keine Möglichkeit den Wert zu setzen, da Write und Read gefehlt haben.

markieren

Delphi-Quellcode:

{..}
private
{..}
    FWeekNumbers: Boolean;
{..}
published
    property WeekNumbers: Boolean read FWeekNumbers write FWeekNumbers default False;
{..}

Falls noch Fehler gefunden werden, würde ich mich gerne über Meldungen freuen

LG Mathias

Warum so viel Code? Ich hab mir auch so'n Ding geschrieben, hier der gesamte Quelltext:

markieren

Delphi-Quellcode:

procedure TJanniDateTimePicker.SetWeekNumbers(const Value: Boolean);
begin
  if Value then
  SendMessage(Self.Handle, DTM_FIRST + 11, 0, SendMessage(Self.Handle, DTM_FIRST + 12, 0, 0) or MCS_WEEKNUMBERS)
  else
  SendMessage(Self.Handle, DTM_FIRST + 11, 0, SendMessage(Self.Handle, DTM_FIRST + 12, 0, 0) and not MCS_WEEKNUMBERS);
end;

Zitat von Redeemer:

Warum so viel Code? Ich hab mir auch so'n Ding geschrieben, hier der gesamte Quelltext:

Hallo Janni,

danke für Deine Antwort. Ich mag falsch liegen, jedoch erinnere ich mich irgendwie an die Breite desKalnders, der nicht immer korrekt passt.

Ich kann es Dir nicht sagen.

In meiner Komponente ist auch noch ein OnMouseEnter/Leave mit drin.

LG

Ich hatte damals viel rumprobiert und hatte auch mit diversem Code, den ich irgendwo gefunden hatte, Probleme mit der Breite. Diese Lösungen hatten gemeinsam, dass sie im Dropdown-Event den MonthCal geholt und verändert hatten, so wie du. Wenn ich mich recht erinnere, war die Breite beim ersten Öffnen des DropDowns immer falsch.
Dann hab ich in der Microsoft-Doku gefunden, dass nicht nur das Month-Cal-Control sondern auch das Date-Picker-Control eine WeekNumbers-Eigenschaft hat. Leider scheint mein Code auf Frames nur zu funktionieren, wenn er erst nach dem Erstellen des Frames aufgerufen wird. Die Anpassbarkeit ist natürlich geringer.

Zitat von NoGAD:

markieren

Delphi-Quellcode:

Constructor TTRM_DateTimePicker.Create(AOwner: tComponent);
begin
  Inherited Create(AOwner);
  FExtraSpaceX := 12;
  FExtraSpaceY := 12;
  WeekNumbers := True;
  Self.Date := Now;
  DateFormat := dfLong;
end;

Ich würde WeekNumbers := True; nicht so verwenden.

markieren

Delphi-Quellcode:

  Self.WeekNumbers := True;
oder
  FWeekNumbers := True;

Zitat von KodeZwerg:

Ich würde WeekNumbers := True; nicht so verwenden.

markieren

Delphi-Quellcode:

  Self.WeekNumbers := True;
oder
  FWeekNumbers := True;

Wo soll denn der Unterschied sein zwischen einem WeekNumbers := True; und Self.WeekNumbers := True; ?

Zitat von Uwe Raabe:

Zitat von KodeZwerg:

Ich würde WeekNumbers := True; nicht so verwenden.

markieren

Delphi-Quellcode:

  Self.WeekNumbers := True;
oder
  FWeekNumbers := True;

Wo soll denn der Unterschied sein zwischen einem WeekNumbers := True; und Self.WeekNumbers := True; ?

Aus Sicht des Lesers:
Für mich in der Lesbarkeit des Quelltextes um ohne hin und her scrollen zu müssen zu Wissen das es sich um eine interne Sache handelt.
DateFormat := dfLong; als Gegenstück dazu zeigt einem sofort, hey Leser ich komme von woanders her.

Aus Sicht der Ausführung:
Das Ergebnis bleibt das selbe.

Zitat von KodeZwerg:

Für mich in der Lesbarkeit des Quelltextes um ohne hin und her scrollen zu müssen zu Wissen das es sich um eine interne Sache handelt.
DateFormat := dfLong; als Gegenstück dazu zeigt einem sofort, hey Leser ich komme von woanders her.

Diese Unterscheidung bei der Behandlung der beiden Properties DateFormat und WeekNumbers erschließt sich mir immer noch nicht. Warum bei WeekNumbers ein Self davor, aber bei DateFormat nicht?

Zitat von Uwe Raabe:

Zitat von KodeZwerg:

Für mich in der Lesbarkeit des Quelltextes um ohne hin und her scrollen zu müssen zu Wissen das es sich um eine interne Sache handelt.
DateFormat := dfLong; als Gegenstück dazu zeigt einem sofort, hey Leser ich komme von woanders her.

Diese Unterscheidung bei der Behandlung der beiden Properties DateFormat und WeekNumbers erschließt sich mir immer noch nicht. Warum bei WeekNumbers ein Self davor, aber bei DateFormat nicht?

Weil DateFormat aus unit Vcl.ComCtrls kommt und WeekNumbers eine property der eigenen Klasse ist (Self)