DateTimePicker - immer eine Übersicht der Monate aufklappen

[NoGAD]

Hallo,

bei einem TDateTimePicker gibt es die Möglichkeit, wenn man einmal auf den Monat im Kopfbereich klickt, dass sich alle Monate des Jahres zeigen. Danach dann etliche Jahre als Übersicht usw.

Gibt es eine Möglichkeit, schon beim Öffnen der Komponente, diese Monatsansicht (https://www.delphipraxis.net/attachm...1&d=1571918179) zu forcieren?

LG Mathias

[Uwe Raabe]

Der folgende Class Helper stellt dafür eine Methode zur Verfügung:

Delphi-Quellcode:

type
  TDateTimePickerHelper = class helper for TDateTimePicker
  public
    procedure ShowMonthCalendar;
  end;

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

[Uwe Raabe]

Zitat von Frühlingsrolle:

Weisst du, warum der direkte Aufruf (z.B. im TDateTimePicker.OnDropDown) des Makros keine Auswirkung auf das DateTimePicker Control hat?

Ich weiß jetzt nicht, was du meinst.

Das Property CalendarHandle ist protected und ohne den Class Helper oder ein entsprechendes Konstrukt nicht erreichbar.

[Uwe Raabe]

MonthCal_SetCurrentView erwartet das CalendarHandle und nicht das Handle des DateTimePickers. Aber das CalendarHandle ist eben protected.

[NoGAD]

Ihr zwei seid Klasse!

Uwe, Deinen Code habe ich in meine abgeleitete Klasse des DateTimePickers gepackt und es funktioniert perfekt.


Hier mein TTRM_DateTimePicker als installierbare unit.

LG Mathias

Code:

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 := StrToDate( '15.06.1998' );

  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.

[NoGAD]

Zitat von Uwe Raabe:

Das Property CalendarHandle ist protected und ohne den Class Helper oder ein entsprechendes Konstrukt nicht erreichbar.

Woher bekommt man solche Infos?

LG Mathias