TDateTimePicker : Select a Month [Edit]

I would like to select only a month with a TDateTimePicker. To do that, I use the mask 'MMM yyyy' for the Format property. But i always need to select a day to close the dropdown calendar.
I need two things :
First : in the OnDropDown event, how to go directly to the month select page of the calendar ?
Second : When I click on a month in the calendar, how to generate the OnCloseUp event ?

Thanks

Edited by: Lionel Reynaud on Nov 1, 2011 2:29 AM
0
Lionel
11/1/2011 9:30:00 AM
embarcadero.delphi.vcl.using 2297 articles. 2 followers. Follow

13 Replies
5581 Views

Similar Articles

[PageSpeed] 2
Get it on Google Play
Get it on Apple App Store

<Lionel Reynaud> wrote in message news:415830@forums.embarcadero.com...

> I would like to select only a month with a TDateTimePicker.
> To do that, I use the mask 'MMM yyyy' for the Format
> property. But i always need to select a day to close the
> dropdown calendar.

The drop-down calendar is not designed for that kind of input.  You will 
have to disable the native calendar from appearing and display your own 
custom calendar instead.

-- 
Remy Lebeau (TeamB)
0
Remy
11/1/2011 6:34:10 PM
Well, I found a solution for the second point : In the OnChange Event, I kill the focus of TDateTimePicker if we have changed the month :

procedure TForm1.DatePickerEditChange(Sender: TObject);
begin
        if YearOf(FDropDate) <> YearOf(DatePickerEdit.Date) then
          FDropDate := RecodeYear(FDropDate,YearOf(DatePickerEdit.Date))
        else
          if MonthOf(FDropDate) <> MonthOf(DatePickerEdit.Date) then
                     DatePickerEdit.Parent.SetFocus;
end;

FDropDate is initialised in the OnDropDown event.

procedure TForm1.DatePickerEditDropDown(Sender: TObject);
begin
  FDropDate := DatePickerEdit.Date;
end;

Edited by: Lionel Reynaud on Nov 1, 2011 11:47 AM
1
Lionel
11/1/2011 6:49:04 PM
> {quote:title=Remy Lebeau (TeamB) wrote:}{quote}
> <Lionel Reynaud> wrote in message news:415830@forums.embarcadero.com...
> 
> > I would like to select only a month with a TDateTimePicker.
> > To do that, I use the mask 'MMM yyyy' for the Format
> > property. But i always need to select a day to close the
> > dropdown calendar.
> 
> The drop-down calendar is not designed for that kind of input.  You will 
> have to disable the native calendar from appearing and display your own 
> custom calendar instead.
> 
> -- 
> Remy Lebeau (TeamB)


Well, this is not a good solution for my objective ! Indeed, in the program, the user is first asked to select which time interval he want (day/month/year) and I want after to have the same look for the selection.I solved the second point and I don't see why the first point could not be solved. I don't know how to do, but I probably can simulate a Click on the header of the calendar to force the month page to appear ... no ?
0
Lionel
11/3/2011 1:40:35 PM
Well, I progress. Indeed, that work fine when I simulate a click on the Calendar month title.

But, I maybe found better. There exist a function : MonthCal_SetCurrentView that probably does the trick. But unfortunatly, this function aren't defined in Delphi. How can I do to define it ?
0
Lionel
11/3/2011 3:15:23 PM
Ok, can't found how to get the missing function, but I found an alternative :

const
  MCM_SETCURRENTVIEW = MCM_FIRST+32;
  MCMV_MONTH = 1;
var
   wnd: HWND;

  wnd := DateTime_GetMonthCal(DatePickerEdit.Handle) ;
  if wnd <> 0 then
  begin
    lResult := SendMessage(wnd,MCM_SETCURRENTVIEW,0,MCMV_MONTH);
  end;

Work !!!!
0
Lionel
11/3/2011 4:27:59 PM
<Lionel Reynaud> wrote in message news:416556@forums.embarcadero.com...

> But, I maybe found better. There exist a function :
> MonthCal_SetCurrentView that probably does the trick.
> But unfortunatly, this function aren't defined in Delphi.
> How can I do to define it ?

Like this:

{code:delphi}
const
  MCM_SETCURRENTVIEW = MCM_FIRST+32;

function MonthCal_SetCurrentView(hmc: HWND; dwNewView: DWORD): Boolean;
begin
  Result := SendMessage(hmc, MCM_SETCURRENTVIEW, 0, dwNewView) <> 0;
end;
{code}

Then you can call it like this:

{code:delphi}
const
  MCMV_MONTH = 1;
var
  wnd: HWND;
begin
  wnd := DateTime_GetMonthCal(DatePickerEdit.Handle);
  if wnd <> 0 then
    MonthCal_SetCurrentView(wnd, MCMV_MONTH);
end;
{code}

-- 
Remy Lebeau (TeamB)
0
Remy
11/3/2011 4:55:33 PM
Good !

I have another question : the DateTimePicker use the MonthCalendar object. The problem is that the events generated in the MonthCalendar (in particularly the MCN_SELECT, and MCN_SELCHANGE messages) are not transmited to the DateTimePicker (we have only the DTN_DATETIMECHANGE message).

Like I know the handle of the MonthCalendar (with DateTime_GetMonthCal function), I would know if there are a way to "capture" the messages send by the MonthCalendar ? Is it possible to attach a "CNNotify" procedure ?
0
Lionel
11/4/2011 9:24:33 AM
<Lionel Reynaud> wrote in message news:416751@forums.embarcadero.com...

> Like I know the handle of the MonthCalendar (with DateTime_GetMonthCal 
> function),
> I would know if there are a way to "capture" the messages send by the 
> MonthCalendar ?
> Is it possible to attach a "CNNotify" procedure ?

Subclass the TDateTimePicker's window, using either its WindowProc property 
or the Win32 API SetWindowLong() function, and have it catch WM_NOTIFY 
messages directly (not CN_NOTIFY, which are WM_NOTIFY messages that are 
repackaged and delivered to the MonthCalendar's window).

-- 
Remy Lebeau (TeamB)
0
Remy
11/4/2011 6:42:44 PM
> {quote:title=Remy Lebeau (TeamB) wrote:}{quote}

> Subclass the TDateTimePicker's window, using either its WindowProc property 
> or the Win32 API SetWindowLong() function, and have it catch WM_NOTIFY 
> messages directly (not CN_NOTIFY, which are WM_NOTIFY messages that are 
> repackaged and delivered to the MonthCalendar's window).
> 
> -- 
Ok, I do the following thing :
{code}
type TMyDateTimePicker = Class(TDateTimePicker)
private
  procedure WndProc(var msg : TMessage); override;
end;

procedure TMyDateTimePicker.WndProc(var msg : TMessage); 
begin
  if (msg.msg = WM_NOTIFY) then 
       ShowMessage(Format('%d;%d',[msg.WParam,msg.LParam]));
  inherited WndProc(msg);
end;
{code}

To see the events processed. But I have a problem, the msg.LParam values are a big integer (in order of 1244572) and I have no correspondance with the pre-defined constants DTN_DROPDOWN, DTN_CLOSEUP, .... An idea ?

Thanks for your patience and read my english :)
0
Lionel
11/5/2011 2:14:08 PM
Lionel Reynaud wrote:

> > {quote:title=Remy Lebeau (TeamB) wrote:}{quote}
> 
> > Subclass the TDateTimePicker's window, using either its WindowProc property 
> > or the Win32 API SetWindowLong() function, and have it catch WM_NOTIFY 
> > messages directly (not CN_NOTIFY, which are WM_NOTIFY messages that are 
> > repackaged and delivered to the MonthCalendar's window).
> > 
> > -- 
> Ok, I do the following thing :
> {code}
> type TMyDateTimePicker = Class(TDateTimePicker)
> private
>   procedure WndProc(var msg : TMessage); override;
> end;
> 
> procedure TMyDateTimePicker.WndProc(var msg : TMessage); 
> begin
>   if (msg.msg = WM_NOTIFY) then 
>        ShowMessage(Format('%d;%d',[msg.WParam,msg.LParam]));
>   inherited WndProc(msg);
> end;
> {code}
> 
> To see the events processed. But I have a problem, the msg.LParam values are a big integer (in
> order of 1244572) and I have no correspondance with the pre-defined constants DTN_DROPDOWN,
> DTN_CLOSEUP, .... An idea ?
> 
> Thanks for your patience and read my english :)

Lionel,
The LParam of the WM_NOTIFY message is a pointer to a NMHDR structure:
http://msdn.microsoft.com/en-us/library/bb775583(v=VS.85).aspx

The NMHDR structure is defined as:
typedef struct tagNMHDR {
  HWND     hwndFrom;
  UINT_PTR idFrom;
  UINT     code;
} NMHDR;
http://msdn.microsoft.com/en-us/library/bb775514(v=VS.85).aspx

In Delphi (Windows.pas) the structure is defined as:
  PNMHdr = ^TNMHdr;
  {$EXTERNALSYM tagNMHDR}
  tagNMHDR = packed record
    hwndFrom: HWND;
    idFrom: UINT;
    code: Integer;     { NM_ code }
  end;

Using the PNMHDR pointer you can read the notification code from the LParam like this:
    ShowMessage(sysutils.format('%d, %d',[msg.WParam, PNMHDR(msg.LParam).code]));

The DTN_xxx constants are declared in CommCtrl.pas, but I wonder how they should be interpreted:

  {$EXTERNALSYM DTN_FIRST}
  DTN_FIRST                = 0-760;       { datetimepick }
  {$EXTERNALSYM DTN_LAST}
  DTN_LAST                 = 0-799;

and

  // Notification codes
  {$EXTERNALSYM DTN_DATETIMECHANGE}
  DTN_DATETIMECHANGE = DTN_FIRST + 1;  // the systemtime has changed
  {$EXTERNALSYM DTN_USERSTRINGA}
  DTN_USERSTRINGA    = DTN_FIRST + 2;  // the user has entered a string
  {$EXTERNALSYM DTN_USERSTRINGW}
  DTN_USERSTRINGW    = DTN_FIRST + 15;
.....

Since DTN_FIRST is negative and the identifiers are *added* to DTN_FIRST the codes will not be in
the range DTN_FIRST .. DTN_LAST.


Cheers
Tom

-- 
Tom Brunberg
firstname.surname@welho.com
0
Tom
11/6/2011 9:13:56 AM
Many thanks Tom, that work now :)

But really, I find now directly in the code (PNMHDR(msg.LParam).code) the constants MCN_SELECT and MCN_SELCHANGE (constants from the monthcalendar), but I need to make a shift of +196 to found the constant DTN_DROPDOWN and DTN_CLOSEUP (constants from the datetimepicker).
Strange, but well, I can manage this !

So many thanks again to you and Remy for your answer.
0
Lionel
11/6/2011 4:35:58 PM
For those who are interested, the code of the extension of the TDateTimePicker :
{code}
unit unDateTimePickerEx;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, ComCtrls, CommCtrl;

const
  MCM_GETCURRENTVIEW = MCM_FIRST+22;
  MCM_SETCURRENTVIEW = MCM_FIRST+32;
  MCMV_DAY = 0;
  MCMV_MONTH = 1;
  MCMV_YEAR = 2;
  MCMV_DECADE = 3;
  MCMV_CENTURY = 4;
  MCN_VIEWCHANGE = MCN_FIRST+0;

type
  TDateTimeView = (dtvDay = 0, dtvMonth = 1, dtvYear = 2);
  TViewChangeEvent = procedure (Sender: TObject; aNewView: DWORD) of object;

type
  TDateTimePickerEx = class(TDateTimePicker)
  private
    FOldProc: TWndMethod;
    FShowToday: boolean;
    FMinVistaVersion: boolean;
    FDropDate: TDate;
    FCurrentDate: TDate;
    FPosition: TPoint;
    FDateTimeView: TDateTimeView;
    FOnSelect: TNotifyEvent;
    FOnSelChange: TNotifyEvent;
    FOnViewChange: TViewChangeEvent;

    procedure DateTimePickerProc(var msg : TMessage);
    procedure DoViewChange;
    procedure DoDropDown;
    procedure SetDateTimeView(const Value: TDateTimeView);
    procedure Mouse_Click(aPosition: TPoint; aDoubleClick: boolean = false);
  protected
    procedure Change; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property DateTimeView: TDateTimeView read FDateTimeView write SetDateTimeView;
    property ShowToday: boolean read FShowToday write FShowToday;
    property OnSelect: TNotifyEvent read FOnSelect write FOnSelect;
    property OnSelChange: TNotifyEvent read FOnSelChange write FOnSelChange;
    property OnViewChange: TViewChangeEvent read FOnViewChange write FOnViewChange;
  end;

function MonthCal_SetCurrentView(hdp: HWND; dwView: DWORD): boolean;
function MonthCal_GetCurrentView(hdp: HWND): DWORD;

procedure Register;

implementation

uses Forms, DateUtils;

procedure Register;
begin
  RegisterComponents('Math', [TDateTimePickerEx]);
end;

function MonthCal_SetCurrentView(hdp: HWND; dwView: DWORD): boolean;
begin
  Result := SendMessage(hdp, MCM_SETCURRENTVIEW, 0, dwView) <> 0;
end;

function MonthCal_GetCurrentView(hdp: HWND): DWORD;
begin
  Result := SendMessage(hdp, MCM_GETCURRENTVIEW, 0, 0);
end;

{ TDateTimePickerEx }

constructor TDateTimePickerEx.Create(AOwner: TComponent);
begin
  inherited;
  // Sauvegarde de la WndProc actuelle
  FOldProc := Self.WindowProc;
  // Affecter une nouvelle procédure
  Self.WindowProc := DateTimePickerProc;

  FMinVistaVersion := Win32MajorVersion >= 6;
  FShowToday := true;
  FDateTimeView := dtvDay;
  FCurrentDate := Self.Date;
end;

procedure TDateTimePickerEx.DateTimePickerProc(var msg: TMessage);
begin
  // interception de WM_NOTIFY
  if (msg.msg = WM_NOTIFY) then
  begin
    case PNMHDR(msg.LParam).code of
      MCN_SELECT : if Assigned(FOnSelect) then FOnSelect(Self);
      MCN_SELCHANGE : if Assigned(FOnSelChange) then FOnSelChange(Self);
      MCN_VIEWCHANGE : begin DoViewChange; Exit; end;
      DTN_DROPDOWN-196 : DoDropDown;
//      DTN_CLOSEUP-196 : DoCloseUp;
    end;
  end;
  if (msg.msg = CM_MOUSEENTER) then
    FCurrentDate := Self.Date;
  // On poursuit le traitement
  FOldProc(msg);
end;

procedure TDateTimePickerEx.Mouse_Click(aPosition: TPoint; aDoubleClick: boolean);
var
  lInput: array [0..1] of TInput;
  lOldPosition: TPoint;
begin
  GetCursorPos(lOldPosition);
  with lInput[0] do
  begin
    Itype := INPUT_MOUSE;
    mi.dwFlags := MOUSEEVENTF_LEFTDOWN or MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE;
    mi.dx := round(aPosition.X * (65535 / Screen.Width));
    mi.dy := round(aPosition.Y * (65535 / Screen.Height));
    mi.time := 0;
    mi.dwExtraInfo := 0;
  end;
  lInput[1] := lInput[0];
  lInput[1].mi.dwFlags := MOUSEEVENTF_LEFTUP or MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE;
  SendInput(2, lInput[0], SizeOf(TInput));
  if aDoubleClick then
    SendInput(2, lInput[0], SizeOf(TInput));
  Application.ProcessMessages;
  SetCursorPos(lOldPosition.X,lOldPosition.Y);
end;

procedure TDateTimePickerEx.DoDropDown;
var
  lCurrentView: integer;
  lPosition: TPoint;
  lStyle: Integer;
  lSystemTime: TSystemTime;
begin
  // WorkAround for the bug when MaxDate is set to a time before current date
  //Re-select the date on the MonthCalendar
  Self.Date := FCurrentDate;
  DateTimeToSystemTime(FCurrentDate,lSystemTime);
  MonthCal_SetCurSel(CalendarHandle,lSystemTime);

  FPosition := Self.ClientToScreen(Point(0,0));
  if FMinVistaVersion then
  begin
    lCurrentView := MonthCal_GetCurrentView(CalendarHandle);
    if lCurrentView <> integer(FDateTimeView) then
      MonthCal_SetCurrentView(CalendarHandle,DWORD(FDateTimeView));
  end
  else
  begin
    // Position of the calendar header
    lPosition.X := FPosition.X + 100;
    lPosition.Y := FPosition.Y + Self.Height + 30;

    if FDateTimeView = dtvMonth then
      Mouse_Click(lPosition);

    if FDateTimeView = dtvYear then
      Mouse_Click(lPosition,true);

    FDropDate := Date;
  end;

  if not FShowToday then
  begin
    lStyle := GetWindowLong(CalendarHandle, GWL_STYLE);
    SetWindowLong(CalendarHandle, GWL_STYLE, lStyle or MCS_NOTODAY or MCS_NOTODAYCIRCLE);
  end;
end;

procedure TDateTimePickerEx.DoViewChange;
var
  lCurrentView: integer;
begin
  if FMinVistaVersion then
  begin
    lCurrentView := MonthCal_GetCurrentView(CalendarHandle);
    if lCurrentView < integer(FDateTimeView) then
      Mouse_Click(FPosition);

    if Assigned(FOnViewChange) then
      FOnViewChange(Self,lCurrentView);
  end;
end;

procedure TDateTimePickerEx.Change;

  function DecadeOf(aDate: TDate):integer;
  begin
    result := Round(Int(YearOf(aDate)/10));
  end;

  procedure DoForceCloseUp;
  var
    lPosition: TPoint;
  begin
    lPosition.X := FPosition.X + 100;
    lPosition.Y := FPosition.Y + Self.Height + 30;
    Mouse_Click(lPosition);
    Mouse_Click(FPosition);
  end;

begin
  // We try to simulate the DoViewChange behaviour
  // not perfect, but work almost always !
  if not FMinVistaVersion then
  begin
    case FDateTimeView of
      dtvDay: ;
      dtvMonth:
        begin
          if YearOf(FDropDate) <> YearOf(Date) then
            FDropDate := RecodeYear(FDropDate,YearOf(Date))
          else
            DoForceCloseUp;
        end;
      dtvYear:
        begin
          if DecadeOf(FDropDate) <> DecadeOf(Date) then
            FDropDate := RecodeYear(FDropDate,YearOf(Date))
          else
            if YearOf(FDropDate) <> YearOf(Date) then
              DoForceCloseUp;
        end;
    end;
  end;
  inherited;
end;

procedure TDateTimePickerEx.SetDateTimeView(const Value: TDateTimeView);
begin
  FDateTimeView := Value;
  case FDateTimeView of
    dtvDay : Format := '';
    dtvMonth: if DateFormat = dfShort then Format := 'MMM yyyy' else Format := 'MMMM yyyy';
    dtvYear: Format := 'An. yyyy';
  end;
end;

end.

{code}
0
Lionel
11/18/2011 10:10:01 AM
Lionel Reynaud wrote:

> For those who are interested, the code of the extension of the TDateTimePicker :
> {code}
> unit unDateTimePickerEx;
> 
> interface
> 
> uses
>   Windows, Messages, SysUtils, Classes, Controls, ComCtrls, CommCtrl;
> 
> const
>   MCM_GETCURRENTVIEW = MCM_FIRST+22;
>   MCM_SETCURRENTVIEW = MCM_FIRST+32;
>   MCMV_DAY = 0;
>   MCMV_MONTH = 1;
>   MCMV_YEAR = 2;
>   MCMV_DECADE = 3;
>   MCMV_CENTURY = 4;
>   MCN_VIEWCHANGE = MCN_FIRST+0;
> 
> type
>   TDateTimeView = (dtvDay = 0, dtvMonth = 1, dtvYear = 2);
>   TViewChangeEvent = procedure (Sender: TObject; aNewView: DWORD) of object;
> 
> type
>   TDateTimePickerEx = class(TDateTimePicker)
>   private
>     FOldProc: TWndMethod;
>     FShowToday: boolean;
>     FMinVistaVersion: boolean;
>     FDropDate: TDate;
>     FCurrentDate: TDate;
>     FPosition: TPoint;
>     FDateTimeView: TDateTimeView;
>     FOnSelect: TNotifyEvent;
>     FOnSelChange: TNotifyEvent;
>     FOnViewChange: TViewChangeEvent;
> 
>     procedure DateTimePickerProc(var msg : TMessage);
>     procedure DoViewChange;
>     procedure DoDropDown;
>     procedure SetDateTimeView(const Value: TDateTimeView);
>     procedure Mouse_Click(aPosition: TPoint; aDoubleClick: boolean = false);
>   protected
>     procedure Change; override;
>   public
>     constructor Create(AOwner: TComponent); override;
>   published
>     property DateTimeView: TDateTimeView read FDateTimeView write SetDateTimeView;
>     property ShowToday: boolean read FShowToday write FShowToday;
>     property OnSelect: TNotifyEvent read FOnSelect write FOnSelect;
>     property OnSelChange: TNotifyEvent read FOnSelChange write FOnSelChange;
>     property OnViewChange: TViewChangeEvent read FOnViewChange write FOnViewChange;
>   end;
> 
> function MonthCal_SetCurrentView(hdp: HWND; dwView: DWORD): boolean;
> function MonthCal_GetCurrentView(hdp: HWND): DWORD;
> 
> procedure Register;
> 
> implementation
> 
> uses Forms, DateUtils;
> 
> procedure Register;
> begin
>   RegisterComponents('Math', [TDateTimePickerEx]);
> end;
> 
> function MonthCal_SetCurrentView(hdp: HWND; dwView: DWORD): boolean;
> begin
>   Result := SendMessage(hdp, MCM_SETCURRENTVIEW, 0, dwView) <> 0;
> end;
> 
> function MonthCal_GetCurrentView(hdp: HWND): DWORD;
> begin
>   Result := SendMessage(hdp, MCM_GETCURRENTVIEW, 0, 0);
> end;
> 
> { TDateTimePickerEx }
> 
> constructor TDateTimePickerEx.Create(AOwner: TComponent);
> begin
>   inherited;
>   // Sauvegarde de la WndProc actuelle
>   FOldProc := Self.WindowProc;
>   // Affecter une nouvelle procédure
>   Self.WindowProc := DateTimePickerProc;
> 
>   FMinVistaVersion := Win32MajorVersion >= 6;
>   FShowToday := true;
>   FDateTimeView := dtvDay;
>   FCurrentDate := Self.Date;
> end;
> 
> procedure TDateTimePickerEx.DateTimePickerProc(var msg: TMessage);
> begin
>   // interception de WM_NOTIFY
>   if (msg.msg = WM_NOTIFY) then
>   begin
>     case PNMHDR(msg.LParam).code of
>       MCN_SELECT : if Assigned(FOnSelect) then FOnSelect(Self);
>       MCN_SELCHANGE : if Assigned(FOnSelChange) then FOnSelChange(Self);
>       MCN_VIEWCHANGE : begin DoViewChange; Exit; end;
>       DTN_DROPDOWN-196 : DoDropDown;
> //      DTN_CLOSEUP-196 : DoCloseUp;
>     end;
>   end;
>   if (msg.msg = CM_MOUSEENTER) then
>     FCurrentDate := Self.Date;
>   // On poursuit le traitement
>   FOldProc(msg);
> end;
> 
> procedure TDateTimePickerEx.Mouse_Click(aPosition: TPoint; aDoubleClick: boolean);
> var
>   lInput: array [0..1] of TInput;
>   lOldPosition: TPoint;
> begin
>   GetCursorPos(lOldPosition);
>   with lInput[0] do
>   begin
>     Itype := INPUT_MOUSE;
>     mi.dwFlags := MOUSEEVENTF_LEFTDOWN or MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE;
>     mi.dx := round(aPosition.X * (65535 / Screen.Width));
>     mi.dy := round(aPosition.Y * (65535 / Screen.Height));
>     mi.time := 0;
>     mi.dwExtraInfo := 0;
>   end;
>   lInput[1] := lInput[0];
>   lInput[1].mi.dwFlags := MOUSEEVENTF_LEFTUP or MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE;
>   SendInput(2, lInput[0], SizeOf(TInput));
>   if aDoubleClick then
>     SendInput(2, lInput[0], SizeOf(TInput));
>   Application.ProcessMessages;
>   SetCursorPos(lOldPosition.X,lOldPosition.Y);
> end;
> 
> procedure TDateTimePickerEx.DoDropDown;
> var
>   lCurrentView: integer;
>   lPosition: TPoint;
>   lStyle: Integer;
>   lSystemTime: TSystemTime;
> begin
>   // WorkAround for the bug when MaxDate is set to a time before current date
>   //Re-select the date on the MonthCalendar
>   Self.Date := FCurrentDate;
>   DateTimeToSystemTime(FCurrentDate,lSystemTime);
>   MonthCal_SetCurSel(CalendarHandle,lSystemTime);
> 
>   FPosition := Self.ClientToScreen(Point(0,0));
>   if FMinVistaVersion then
>   begin
>     lCurrentView := MonthCal_GetCurrentView(CalendarHandle);
>     if lCurrentView <> integer(FDateTimeView) then
>       MonthCal_SetCurrentView(CalendarHandle,DWORD(FDateTimeView));
>   end
>   else
>   begin
>     // Position of the calendar header
>     lPosition.X := FPosition.X + 100;
>     lPosition.Y := FPosition.Y + Self.Height + 30;
> 
>     if FDateTimeView = dtvMonth then
>       Mouse_Click(lPosition);
> 
>     if FDateTimeView = dtvYear then
>       Mouse_Click(lPosition,true);
> 
>     FDropDate := Date;
>   end;
> 
>   if not FShowToday then
>   begin
>     lStyle := GetWindowLong(CalendarHandle, GWL_STYLE);
>     SetWindowLong(CalendarHandle, GWL_STYLE, lStyle or MCS_NOTODAY or MCS_NOTODAYCIRCLE);
>   end;
> end;
> 
> procedure TDateTimePickerEx.DoViewChange;
> var
>   lCurrentView: integer;
> begin
>   if FMinVistaVersion then
>   begin
>     lCurrentView := MonthCal_GetCurrentView(CalendarHandle);
>     if lCurrentView < integer(FDateTimeView) then
>       Mouse_Click(FPosition);
> 
>     if Assigned(FOnViewChange) then
>       FOnViewChange(Self,lCurrentView);
>   end;
> end;
> 
> procedure TDateTimePickerEx.Change;
> 
>   function DecadeOf(aDate: TDate):integer;
>   begin
>     result := Round(Int(YearOf(aDate)/10));
>   end;
> 
>   procedure DoForceCloseUp;
>   var
>     lPosition: TPoint;
>   begin
>     lPosition.X := FPosition.X + 100;
>     lPosition.Y := FPosition.Y + Self.Height + 30;
>     Mouse_Click(lPosition);
>     Mouse_Click(FPosition);
>   end;
> 
> begin
>   // We try to simulate the DoViewChange behaviour
>   // not perfect, but work almost always !
>   if not FMinVistaVersion then
>   begin
>     case FDateTimeView of
>       dtvDay: ;
>       dtvMonth:
>         begin
>           if YearOf(FDropDate) <> YearOf(Date) then
>             FDropDate := RecodeYear(FDropDate,YearOf(Date))
>           else
>             DoForceCloseUp;
>         end;
>       dtvYear:
>         begin
>           if DecadeOf(FDropDate) <> DecadeOf(Date) then
>             FDropDate := RecodeYear(FDropDate,YearOf(Date))
>           else
>             if YearOf(FDropDate) <> YearOf(Date) then
>               DoForceCloseUp;
>         end;
>     end;
>   end;
>   inherited;
> end;
> 
> procedure TDateTimePickerEx.SetDateTimeView(const Value: TDateTimeView);
> begin
>   FDateTimeView := Value;
>   case FDateTimeView of
>     dtvDay : Format := '';
>     dtvMonth: if DateFormat = dfShort then Format := 'MMM yyyy' else Format := 'MMMM yyyy';
>     dtvYear: Format := 'An. yyyy';
>   end;
> end;
> 
> end.
> 
> {code}

Thank you Lionel, very interesting.

-- 
Tom Brunberg
firstname.surname@welho.com
0
Tom
11/18/2011 11:19:41 AM
Reply:

Similar Artilces:

Cannot use Microsoft Excel when a Delphi application that uses automat. run [Edit]
Dear all, I built an application that connect to an Excel file using a OleObject: Excel := CreateOleObject('Excel.Application'); LCID := GetUserDefaultLCID; all works fine but I cannot use Microsoft Excel externally when my application is running. If I try to open another xls file, Excel tries to open the file in my Delphi application in read only mode. It does not even show it properly but opens a weir transparent application. I just want to be able to use Excel externally and I'd like the instance opened by my Delphi application to be independent from other Exc...

Problem using InstallAware 7 CodeGear Special Edition with Delphi 2010 [Edit]
Hi Everyone, I am trying to create an installation disk for my delphi 2010 application using the installAware that kind of comes with Delphi 2010. When I try to built it, it keeps giving me the error message:- No files matching pattern "C:\Windows\system32\\*120.bpl" and when I look into my windows\system32 folder, there the files with extension *.bpl end with *140.bpl and not *120.bpl like it was expected. Can anyone tell me if I am doing something wrong or how I can get around this. Thanks in advance. Edited by: Tat Hon Chu on Dec 3, 2009 12:55 AM > {quo...

To use or not to use Delphi
Sadly, it seems to me that there is a sort of race between the two threads, for and against using Delphi in new projects, with more or less the same users posting in both threads. Arguments are fiercely debated in both camps. Borland had their own vision. As a community, now that Delphi has changed ownership I believe we should try to be more consistent, more clear, and more articulate in what we expect from Embercadero in terms of Delphi. We can contribute to keeping Delphi alive and moving in the right direction. "Laurent Cocea" schrieb: > Sadly, it seems to me that there ...

superreview granted: [Bug 210676] Editing existing selection list deletes it (using Debug/Form/Selection List) : [Attachment 126563] Ugly hack :-(
Alec Flett <alecf@flett.org> has granted neil@parkwaycc.co.uk <neil.parkwaycc.co.uk@myrealbox.com>'s request for superreview: Bug 210676: Editing existing selection list deletes it (using Debug/Form/Selection List) http://bugzilla.mozilla.org/show_bug.cgi?id=210676 Attachment 126563: Ugly hack :-( http://bugzilla.mozilla.org/attachment.cgi?id=126563&action=edit ...

Using the CalendarExtender to select the month only?
Hi,  Can you use the CalenderExtender to just display months and ignore days.  ie.  Like when you click on the month it just displays the months.  Can you configure it to do this all the time and ignore days? it watches the property FormatString I've found the Format property but no FormatString property.  Doesn't this just format the TargetControl?  I want to format the actual CalendarExtender control.   ...

ANN: The free to use kbmMW 3.51.00 CodeGear Edition and kbmMemTable v. 7.00.01 Beta 1 CodeGear Edition for Delphi XE, has been released!
We are happy to announce the immediate availability of the free to use kbmMW v. 3.51.00 CodeGear Edition and kbmMemTable v. 7.00.01 CodeGear Edition for Delphi XE! The keywords for this release are: - Delphi XE support - Highly optimized performance in master/detail and ranges in kbmMemTable. - New GroupBy function in kbmMemTable. - Improved support for fielddefinitions with data, even in master/detail relations - Performance enhancements - Multithreading enhancements - Dataset enhancements - Stability enhancements and bugfixes Remember the free kbmMemTable CodeGear Edition ...

selecting month from a date and using it in a SQL Where?
Hi! I have a long list of events sorted on dates.I want to shorten down the list by only showing the dates from one month. My selectcommand looks like this, so far: SELECT [date], [event] FROM [calendar] ORDER BY [date]" Is there a way to use WHERE Month(date)=01 ? or DateTime.Now.Month?   thanx  You can use the DatePart function:WHERE DatePart(m, [date]) = 1I hope that helps.  It'll take a combination of the SUBSTRING and CONVERT functions: SELECT [date], [event], FROM [calendar] WHERE SUBSTRING(CONVERT(varchar(24), [date], 101), 0, 3)=@mont...

On Using C++ code from Delphi [Edit]
Hello, one of the most frequently requested - but never realized - features for Delphi is the ability to use C++ code. I'd like to know about your needs regarding C++, and how you think about such a feature. - Is it critical for you to be able to use 3rd-party C++ libraries and C++ classes in Delphi without further changes or additional work? - Or do you want to use VCL components written in C++ in your Delphi projects? - Imagine a solution that makes C++ classes visible to Delphi code, with the following restrictions: o the C++ code needs to be built with C++Builder, o t...

How can you guys use Delphi? :) [Edit]
This message is no longer available. Seems that my post was deleted. (Rudy don't you have anything more useful to do?) So here it goes: Every few years I take the current updated version of Delphi for a test drive and go back to Delphi7. This time I installed Xe3 and compiled my project. Gee, the resulting program was full of flickers. A brief mouse cursor move on controls to show the hints left black rectangles on the GUI :D and the exe grew from 3.08 MB to 5.57 MB. By the way, am I right to think that all versions since D7 are tied to different dotnet versions? Edited by: Bob ...

Using WordApplication in Delphi 2010 [Edit]
Hello Everyone, I am having a problem with WordApplicatio component. I am using Delphi 10. I can get the WordApplication to open with the Document template that I select, but Word is behind my app and when I close Word I get an RPC Server not available errror and after that a pointer violation and then access violations until I reset the IDE. Here is the code I am using: procedure TTestLetterForm.Button1Click(Sender: TObject); var FileName: oleVariant; begin //Letter2Report.Print; if OpenDialog.Execute = True then begin FileName := OpenDialog.Fil...

How to use IThumbnailProvider in Delphi 2010? [Edit]
Hello, I try to use IThumbnailProvider for getting thumbnail from the file. I can not get ThumbnailProvider, the result of the line "result := fileShellItem.BindToHandler(nil, BHID_ThumbnailHandler, IID_IThumbnailProvider, thumbProvider );" is always false. Could someone help me? Regards Eric P.S. I use Win7/64 type {$EXTERNALSYM IThumbnailProvider} IThumbnailProvider = interface(IUnknown) ['{e357fccd-a995-4576-b01f-234630154e96}'] function GetThumbnail(cx : uint; out hBitmap : HBITMAP; out bitmapType : dword):HRESULT;stdcall; end; const ...

Problem with printing, using Delphi XE2 [Edit]
I have problem with printing images using Delphi XE2. I have code Delphi 7, and this code work very well. {code} procedure Print; var ImgName: string; rect: TRect; jpg: TJPEGImage; begin OpenPictureDialog1.Execute; ImgName := OpenPictureDialog1.FileName; rect.TopLeft:=Point(0,0); rect.BottomRight:=Point(Printer.PageWidth,Printer.PageHeight); jpg := TJPEGImage.Create; jpg.LoadFromFile(ImgName); Printer.BeginDoc; Printer.Canvas.StretchDraw(rect,jpg); Printer.EndDoc; end; {code} But this code Delphi XE2 is not work, printer print clear sheets. (HP ...

How to debug VCL core module in Delphi [Edit]
Hi, all. One of the Delphi programming strength is that VCL source code is opened compared with other compiler. Somtimes, I need to debug VCL core module such as Classes,pas or Forms.pas. Let me introduce simple tips. I will show you an example using Classes.pas file. 1. Make Project and save. 2. Goto Classes.pas. Ctrl C+V all file contents. 3. Add New - Unit, Ctrl+V, and save Classes.pas into the same folder with the project. 4. Try to debug. 5. When you try to add some VCL unit, you can meet the following error. *The project already contains a form or module names "......

How to use Visual VCL in user session [Edit]
Hi, We have a visual VCL that we created. We want to use it (as non visual) with IW project. When we try to create it with each user session, we get this error while compiling when we try to sent its parent as MyComponent.Parent := Self; [DCC Error] UserSessionUnit.pas(291): E2010 Incompatible types: 'TWinControl' and 'TIWUserSession' Is there is a way to overcome this? License Number: 201122682 IntraWeb Version: 12.1.20 -- BR M. Hammady Edited by: Mohamed Hammady on Feb 25, 2012 1:06 PM ...

Web resources about - TDateTimePicker : Select a Month [Edit] - embarcadero.delphi.vcl.using

Resources last updated: 1/21/2016 1:57:30 AM