Merged revision(s) 51694-51695 #d0a37e168d-#d0a37e168d from trunk:

LCL: Implement TCustomCalendar.GetCalendarView. Patch by Zoran Vučenović.
........
LCL: Try not to close CalendarDialogs if CurrentView <> cvMonth. Partly resolves Issue #0029646.
........

git-svn-id: branches/fixes_1_6@52170 -

lcl/calendar.pp

@@ -55,6 +55,16 @@ type
     cpTitleYear     // year value in the title
   );
 
+  { In Windows since Vista native calendar control has four possible views.
+    In other widgetsets, as well as in older windows, calendar can only have
+    standard "month view" - grid with days representing a month. }
+  TCalendarView = (
+    cvMonth,  // grid with days in one month
+    cvYear,   // grid with months in one year
+    cvDecade, // grid with years from one decade
+    cvCentury // grid with decades of one century
+  );
+
   EInvalidDate = class(Exception);
 
   { TCustomCalendar }
@@ -90,6 +100,7 @@ type
   public
     constructor Create(AOwner: TComponent); override;
     function HitTest(APoint: TPoint): TCalendarPart;
+    function GetCalendarView: TCalendarView;
     property Date: String read GetDate write SetDate stored False;
     property DateTime: TDateTime read GetDateTime write SetDateTime;
     property DisplaySettings: TDisplaySettings read GetDisplaySettings
@@ -173,6 +184,14 @@ begin
     Result := cpNoWhere;
 end;
 
+function TCustomCalendar.GetCalendarView: TCalendarView;
+begin
+  if HandleAllocated then
+    Result := TWSCustomCalendarClass(WidgetSetClass).GetCurrentView(Self)
+  else
+    Result := cvMonth;
+end;
+
 procedure TCustomCalendar.Loaded;
 begin
   inherited Loaded;

lcl/extdlgs.pas

@@ -667,9 +667,12 @@ procedure TCalendarDialog.CalendarDblClick(Sender: TObject);
 var
   CalendarForm: TForm;
   P: TPoint;
+  htRes: TCalendarPart;
 begin
   P := FCalendar.ScreenToClient(Mouse.CursorPos);
-  if FCalendar.HitTest(P) in [cpNoWhere, cpDate] then
+  //if FCalendar.HitTest(P) in [cpNoWhere, cpDate] then
+  htRes := FCalendar.HitTest(P);
+  if {(htRes = cpNoWhere) or }((htRes = cpDate) and (FCalendar.GetCalendarView = cvMonth)) then
   begin
     GetNewDate(Sender);
     CalendarForm:=TForm(TComponent(Sender).Owner);

lcl/forms/calendarpopup.pas

@@ -85,9 +85,11 @@ end;
 procedure TCalendarPopupForm.CalendarDblClick(Sender: TObject);
 var
   P: TPoint;
+  htRes: TCalendarPart;
 begin
   P := Calendar.ScreenToClient(Mouse.CursorPos);
-  if Calendar.HitTest(P) in [cpNoWhere, cpDate] then
+  htRes := Calendar.HitTest(P);
+  if {(htRes = cpNoWhere) or }((htRes = cpDate) and (Calendar.GetCalendarView = cvMonth)) then
     ReturnDate;
 end;
 
@@ -103,7 +105,10 @@ begin
     VK_ESCAPE:
       Close;
     VK_RETURN, VK_SPACE:
-      ReturnDate;
+      if (Calendar.GetCalendarView = cvMonth) then
+        ReturnDate
+      else
+        Handled := False;
     else
       Handled := false;
     end;

lcl/interfaces/win32/win32wscalendar.pp

@@ -48,6 +48,7 @@ type
        const AConstraints: TObject): Boolean; override;
     class function  GetDateTime(const ACalendar: TCustomCalendar): TDateTime; override;
     class function HitTest(const ACalendar: TCustomCalendar; const APoint: TPoint): TCalendarPart; override;
+    class function GetCurrentView(const ACalendar: TCustomCalendar): TCalendarView; override;
     class procedure SetDateTime(const ACalendar: TCustomCalendar; const ADateTime: TDateTime); override;
     class procedure SetDisplaySettings(const ACalendar: TCustomCalendar; const ASettings: TDisplaySettings); override;
   end;
@@ -179,6 +180,26 @@ begin
   end;
 end;
 
+class function TWin32WSCustomCalendar.GetCurrentView(
+  const ACalendar: TCustomCalendar): TCalendarView;
+var
+  CurrentView: LRESULT;
+begin
+  Result := inherited GetCurrentView(ACalendar);
+  if WindowsVersion >= wvVista then begin
+    if not WSCheckHandleAllocated(ACalendar, 'TWin32WSCustomCalendar.GetCurrentView') then
+      Exit;
+
+    CurrentView := SendMessage(ACalendar.Handle, MCM_GETCURRENTVIEW, 0, 0);
+    case CurrentView of
+      MCMV_MONTH: Result := cvMonth;
+      MCMV_YEAR: Result := cvYear;
+      MCMV_DECADE: Result := cvDecade;
+      MCMV_CENTURY: Result := cvCentury;
+    end;
+  end;
+end;
+
 class procedure TWin32WSCustomCalendar.SetDateTime(const ACalendar: TCustomCalendar; const ADateTime: TDateTime);
 var
   ST: SystemTime;

lcl/widgetset/wscalendar.pp

@@ -49,6 +49,7 @@ type
   published
     class function GetDateTime(const ACalendar: TCustomCalendar): TDateTime; virtual;
     class function HitTest(const ACalendar: TCustomCalendar; const APoint: TPoint): TCalendarPart; virtual;
+    class function GetCurrentView(const ACalendar: TCustomCalendar): TCalendarView; virtual;
     class procedure SetDateTime(const ACalendar: TCustomCalendar; const ADateTime: TDateTime); virtual;
     class procedure SetDisplaySettings(const ACalendar: TCustomCalendar; 
       const ADisplaySettings: TDisplaySettings); virtual;
@@ -74,6 +75,12 @@ begin
   Result := cpNoWhere;
 end;
 
+class function TWSCustomCalendar.GetCurrentView(const ACalendar: TCustomCalendar
+  ): TCalendarView;
+begin
+  Result := cvMonth;
+end;
+
 class procedure TWSCustomCalendar.SetDateTime(const ACalendar: TCustomCalendar; const ADateTime: TDateTime);
 begin
 end;