View Issue Details

IDProjectCategoryView StatusLast Update
0029949LazarusLCLpublic2016-04-11 23:43
ReporterwpAssigned ToBart Broersma 
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Platformx86-win32OSWinOS VersionWin7
Product VersionProduct Build 
Target Version1.8Fixed in Version1.8 
Summary0029949: TTimeEdit position issue at screen border and hour display issue
DescriptionThis report covers two issues:
- the popup is not correctly positioned if the TTimeEdit is too close to the monitor bottom.
- the first row of the hour grid scrolls away if the selected time is in the second half of the day.
Steps To ReproduceRun the attached demo. It contains a form with a TTimeEdit set to the time 15:00, the form is moved close to the bottom of the screen. When you open the popup of the TTimeEdit you'll notice that the first row of hours has disappeared (at least here on Windows 7), and that the popup opens from the screen buttom upwards and overlaps with the windows taskbar. It would be better if the bottom edge of the popup would be above the edit instead.

See screenshot "TTimeEdit-before.png"

The provided patch fixes the issue. Screenshot "TTimeEdit-after.png" is taken after applying the patch and shows the correct behavior.

The patch also takes care of the popup staying at its position if the layout is switched between simple and extended mode.
TagsNo tags attached.
Fixed in Revisionr52106, r52118, r52144
LazTarget1.8
WidgetsetWin32/Win64
Attached Files
  • TTimeEdit.patch (3,555 bytes)
    Index: lcl/editbtn.pas
    ===================================================================
    --- lcl/editbtn.pas	(revision 52101)
    +++ lcl/editbtn.pas	(working copy)
    @@ -2092,7 +2092,7 @@
       ATime := GetTime;
       if ATime = NullDate then
         ATime := SysUtils.Time;
    -  ShowTimePopup(PopupOrigin, ATime, Self.DoubleBuffered, @TimePopupReturnTime, @TimePopupShowHide, FSimpleLayout);
    +  ShowTimePopup(PopupOrigin, ATime, Height, Self.DoubleBuffered, @TimePopupReturnTime, @TimePopupShowHide, FSimpleLayout);
     end;
     
     function TTimeEdit.TryParseInput(AInput: String; out ParseResult: TDateTime): Boolean;
    Index: lcl/forms/timepopup.lfm
    ===================================================================
    --- lcl/forms/timepopup.lfm	(revision 52101)
    +++ lcl/forms/timepopup.lfm	(working copy)
    @@ -13,7 +13,7 @@
       OnCreate = FormCreate
       OnDeactivate = FormDeactivate
       PopupMode = pmAuto
    -  LCLVersion = '1.5'
    +  LCLVersion = '1.7'
       object MainPanel: TPanel
         Left = 0
         Height = 185
    Index: lcl/forms/timepopup.pas
    ===================================================================
    --- lcl/forms/timepopup.pas	(revision 52101)
    +++ lcl/forms/timepopup.pas	(working copy)
    @@ -41,6 +41,7 @@
         FOnReturnTime: TReturnTimeEvent;
         FSimpleLayout: Boolean;
         FPopupOrigin: TPoint;
    +    FEditHeight: Integer;
         procedure ActivateDoubleBuffered;
         procedure CalcGridHeights;
         function GetTime: TDateTime;
    @@ -55,7 +56,7 @@
         procedure FormDeactivate(Sender: TObject);
       end;
     
    -procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean;
    +procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const EditHeight: Integer; const DoubleBufferedForm: Boolean;
                             const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent = nil; SimpleLayout: Boolean = True);
     
     implementation
    @@ -62,7 +63,7 @@
     
     {$R *.lfm}
     
    -procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean; const OnReturnTime: TReturnTimeEvent;
    +procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const EditHeight: Integer; const DoubleBufferedForm: Boolean; const OnReturnTime: TReturnTimeEvent;
                             const OnShowHide: TNotifyEvent; SimpleLayout: Boolean);
     var
       NewForm: TTimePopupForm;
    @@ -69,6 +70,7 @@
     begin
       NewForm := TTimePopupForm.Create(nil);
       NewForm.Initialize(Position, ATime);
    +  NewForm.FEditHeight := EditHeight;
       NewForm.FOnReturnTime := OnReturnTime;
       NewForm.OnShow := OnShowHide;
       NewForm.OnHide := OnShowHide;
    @@ -89,6 +91,7 @@
       Minute := MinuteOf(ATime);
       HoursGrid.Col := Hour mod 12;
       HoursGrid.Row := Hour div 12;
    +  HoursGrid.TopRow := 0;  // Avoid morning hours scrolling out of view if time is > 12:00
       if FSimpleLayout then
       begin
         Minute := Minute - (Minute mod 5);
    @@ -259,17 +262,15 @@
     var
       ABounds: TRect;
     begin
    -  ABounds := Screen.MonitorFromPoint(PopupOrigin).BoundsRect;
    +  ABounds := Screen.MonitorFromPoint(PopupOrigin).WorkAreaRect; // take care of taskbar!
       if PopupOrigin.X + Width > ABounds.Right then
         Left := ABounds.Right - Width
       else
         Left := PopupOrigin.X;
       if PopupOrigin.Y + Height > ABounds.Bottom then
    -    Top := ABounds.Bottom - Height
    +    Top := PopupOrigin.Y - FEditHeight - Height
       else
         Top := PopupOrigin.Y;
    -  //store the fitting point, so the form won't move if it layout is changed back to simple
    -  FPopupOrigin := Point(Left, Top);
     end;
     
     procedure TTimePopupForm.ReturnTime;
    
    TTimeEdit.patch (3,555 bytes)
  • TimeEdit-BugReport-29949.zip (2,085 bytes)
  • TTimeEdit-before.png (67,475 bytes)
    TTimeEdit-before.png (67,475 bytes)
  • TTimeEdit-after.png (70,184 bytes)
    TTimeEdit-after.png (70,184 bytes)
  • TTimeEdit-v2.patch (4,569 bytes)
    Index: lcl/editbtn.pas
    ===================================================================
    --- lcl/editbtn.pas	(revision 52101)
    +++ lcl/editbtn.pas	(working copy)
    @@ -2092,7 +2092,7 @@
       ATime := GetTime;
       if ATime = NullDate then
         ATime := SysUtils.Time;
    -  ShowTimePopup(PopupOrigin, ATime, Self.DoubleBuffered, @TimePopupReturnTime, @TimePopupShowHide, FSimpleLayout);
    +  ShowTimePopup(PopupOrigin, -Height, ATime, Self.DoubleBuffered, @TimePopupReturnTime, @TimePopupShowHide, FSimpleLayout);
     end;
     
     function TTimeEdit.TryParseInput(AInput: String; out ParseResult: TDateTime): Boolean;
    Index: lcl/forms/timepopup.lfm
    ===================================================================
    --- lcl/forms/timepopup.lfm	(revision 52101)
    +++ lcl/forms/timepopup.lfm	(working copy)
    @@ -13,7 +13,7 @@
       OnCreate = FormCreate
       OnDeactivate = FormDeactivate
       PopupMode = pmAuto
    -  LCLVersion = '1.5'
    +  LCLVersion = '1.7'
       object MainPanel: TPanel
         Left = 0
         Height = 185
    Index: lcl/forms/timepopup.pas
    ===================================================================
    --- lcl/forms/timepopup.pas	(revision 52101)
    +++ lcl/forms/timepopup.pas	(working copy)
    @@ -41,6 +41,7 @@
         FOnReturnTime: TReturnTimeEvent;
         FSimpleLayout: Boolean;
         FPopupOrigin: TPoint;
    +    FAltPopupOriginDeltaY: Integer;
         procedure ActivateDoubleBuffered;
         procedure CalcGridHeights;
         function GetTime: TDateTime;
    @@ -57,18 +58,35 @@
     
     procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean;
                             const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent = nil; SimpleLayout: Boolean = True);
    +                        overload; deprecated 'Use overloaded version with "AltPositionDeltaY"';
     
    +procedure ShowTimePopup(const Position: TPoint; AltPositionDeltaY: Integer; ATime: TDateTime; const DoubleBufferedForm: Boolean;
    +                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent = nil; SimpleLayout: Boolean = True);
    +                        overload;
    +
     implementation
     
     {$R *.lfm}
     
    -procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean; const OnReturnTime: TReturnTimeEvent;
    +procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime;
    +                        const DoubleBufferedForm: Boolean; const OnReturnTime: TReturnTimeEvent;
                             const OnShowHide: TNotifyEvent; SimpleLayout: Boolean);
    +begin
    +  // AltPositionDeltaY = MaxInt puts the popup at the lowest position possible,
    +  // like in Laz 1.6 and older (--> overlaps the edit)
    +  ShowTimePopup(Position, MaxInt, ATime, DoubleBufferedForm, OnReturnTime,
    +    OnShowHide, SimpleLayout);
    +end;
    +
    +procedure ShowTimePopup(const Position: TPoint; AltPositionDeltaY: Integer; ATime: TDateTime;
    +                        const DoubleBufferedForm: Boolean; const OnReturnTime: TReturnTimeEvent;
    +                        const OnShowHide: TNotifyEvent; SimpleLayout: Boolean);
     var
       NewForm: TTimePopupForm;
     begin
       NewForm := TTimePopupForm.Create(nil);
       NewForm.Initialize(Position, ATime);
    +  NewForm.FAltPopupOriginDeltaY := AltPositionDeltaY;
       NewForm.FOnReturnTime := OnReturnTime;
       NewForm.OnShow := OnShowHide;
       NewForm.OnHide := OnShowHide;
    @@ -89,6 +107,7 @@
       Minute := MinuteOf(ATime);
       HoursGrid.Col := Hour mod 12;
       HoursGrid.Row := Hour div 12;
    +  HoursGrid.TopRow := 0;  // Avoid morning hours scrolling out of view if time is > 12:00
       if FSimpleLayout then
       begin
         Minute := Minute - (Minute mod 5);
    @@ -259,17 +278,21 @@
     var
       ABounds: TRect;
     begin
    -  ABounds := Screen.MonitorFromPoint(PopupOrigin).BoundsRect;
    +  ABounds := Screen.MonitorFromPoint(PopupOrigin).WorkAreaRect; // take care of taskbar
       if PopupOrigin.X + Width > ABounds.Right then
         Left := ABounds.Right - Width
       else
         Left := PopupOrigin.X;
       if PopupOrigin.Y + Height > ABounds.Bottom then
    -    Top := ABounds.Bottom - Height
    -  else
    +  begin
    +    if FAltPopupOriginDeltaY = MaxInt then
    +      Top := ABounds.Bottom - Height
    +    else
    +      Top := PopupOrigin.Y + FAltPopupOriginDeltaY - Height
    +      // Note: FAltPopupOrigin is negative if the popup form is called from a TTimeEdit
    +      // i.e. the bottom of the popup is at the top of the edit
    +  end else
         Top := PopupOrigin.Y;
    -  //store the fitting point, so the form won't move if it layout is changed back to simple
    -  FPopupOrigin := Point(Left, Top);
     end;
     
     procedure TTimePopupForm.ReturnTime;
    
    TTimeEdit-v2.patch (4,569 bytes)
  • TTimeEdit-v3.patch (8,265 bytes)
    Index: lcl/editbtn.pas
    ===================================================================
    --- lcl/editbtn.pas	(revision 52101)
    +++ lcl/editbtn.pas	(working copy)
    @@ -1597,7 +1597,7 @@
       if ADate = NullDate then
         ADate := SysUtils.Date;
       ShowCalendarPopup(PopupOrigin, ADate, CalendarDisplaySettings,
    -                    @CalendarPopupReturnDate, @CalendarPopupShowHide);
    +                    @CalendarPopupReturnDate, @CalendarPopupShowHide, self);
       //Do this after the dialog, otherwise it just looks silly
       if FocusOnButtonClick then FocusAndMaybeSelectAll;
     end;
    @@ -2092,7 +2092,8 @@
       ATime := GetTime;
       if ATime = NullDate then
         ATime := SysUtils.Time;
    -  ShowTimePopup(PopupOrigin, ATime, Self.DoubleBuffered, @TimePopupReturnTime, @TimePopupShowHide, FSimpleLayout);
    +  ShowTimePopup(PopupOrigin, ATime, Self.DoubleBuffered, @TimePopupReturnTime,
    +    @TimePopupShowHide, FSimpleLayout, self);
     end;
     
     function TTimeEdit.TryParseInput(AInput: String; out ParseResult: TDateTime): Boolean;
    Index: lcl/forms/calendarpopup.lfm
    ===================================================================
    --- lcl/forms/calendarpopup.lfm	(revision 52101)
    +++ lcl/forms/calendarpopup.lfm	(working copy)
    @@ -3,7 +3,6 @@
       Height = 192
       Top = 259
       Width = 233
    -  AutoSize = True
       BorderIcons = [biMinimize, biMaximize]
       BorderStyle = bsNone
       Caption = 'CalendarPopupForm'
    @@ -13,17 +12,18 @@
       OnCreate = FormCreate
       OnDeactivate = FormDeactivate
       PopupMode = pmAuto
    -  LCLVersion = '0.9.31'
    +  LCLVersion = '1.7'
       object Calendar: TCalendar
    -    Left = 1
    -    Height = 176
    -    Top = 1
    -    Width = 177
    +    Left = 0
    +    Height = 160
    +    Top = 0
    +    Width = 176
         AutoSize = True
         BorderSpacing.Around = 1
         DateTime = 38823
         OnDblClick = CalendarDblClick
         OnKeyDown = CalendarKeyDown
    +    TabOrder = 0
         TabStop = True
       end
     end
    Index: lcl/forms/calendarpopup.pas
    ===================================================================
    --- lcl/forms/calendarpopup.pas	(revision 52101)
    +++ lcl/forms/calendarpopup.pas	(working copy)
    @@ -37,6 +37,7 @@
       private
         FClosed: boolean;
         FOnReturnDate: TReturnDateEvent;
    +    FCaller: TControl;
         procedure Initialize(const PopupOrigin: TPoint; ADate: TDateTime;
                              const DisplaySettings: TDisplaySettings);
         procedure ReturnDate;
    @@ -46,7 +47,8 @@
     
     procedure ShowCalendarPopup(const Position: TPoint; ADate: TDateTime;
         const CalendarDisplaySettings: TDisplaySettings;
    -    const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil);
    +    const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil;
    +    ACaller: TControl = nil);
     
     implementation
     
    @@ -54,11 +56,13 @@
     
     procedure ShowCalendarPopup(const Position: TPoint; ADate: TDateTime;
       const CalendarDisplaySettings: TDisplaySettings;
    -  const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil);
    +  const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent;
    +  ACaller: TControl);
     var
       PopupForm: TCalendarPopupForm;
     begin
       PopupForm := TCalendarPopupForm.Create(nil);
    +  PopupForm.FCaller := ACaller;
       PopupForm.Initialize(Position, ADate, CalendarDisplaySettings);
       PopupForm.FOnReturnDate := OnReturnDate;
       PopupForm.OnShow := OnShowHide;
    @@ -71,6 +75,8 @@
     procedure TCalendarPopupForm.FormCreate(Sender: TObject);
     begin
       FClosed := false;
    +  ClientWidth := Calendar.Width + 2*Calendar.Left;
    +  ClientHeight := Calendar.Height + 2*Calendar.Top;
       Application.AddOnDeactivateHandler(@FormDeactivate);
     end;
     
    @@ -131,16 +137,32 @@
       ADate: TDateTime; const DisplaySettings: TDisplaySettings);
     var
       ABounds: TRect;
    +  P: TPoint;
     begin
    -  ABounds := Screen.MonitorFromPoint(PopupOrigin).BoundsRect;
    -  if PopupOrigin.X + Width > ABounds.Right then
    +  if Assigned(FCaller) then
    +    P := FCaller.ControlToScreen(Point(0, FCaller.Height))
    +  else
    +    P := PopupOrigin;
    +
    +  ABounds := Screen.MonitorFromPoint(P).WorkAreaRect;
    +  if P.X + Width > ABounds.Right then
         Left := ABounds.Right - Width
    +  else if P.X < ABounds.Left then
    +    Left := ABounds.Left
       else
    -    Left := PopupOrigin.X;
    -  if PopupOrigin.Y + Height > ABounds.Bottom then
    -    Top := ABounds.Bottom - Height
    +    Left := P.X;
    +
    +  if P.Y + Height > ABounds.Bottom then
    +  begin
    +    if Assigned(FCaller) then
    +      Top := P.Y - FCaller.Height - Height
    +    else
    +      Top := ABounds.Bottom - Height;
    +  end else if P.Y < ABounds.Top then
    +    Top := ABounds.Top
       else
         Top := PopupOrigin.Y;
    +
       Calendar.DateTime := ADate;
       Calendar.DisplaySettings:=DisplaySettings;
     end;
    Index: lcl/forms/timepopup.lfm
    ===================================================================
    --- lcl/forms/timepopup.lfm	(revision 52101)
    +++ lcl/forms/timepopup.lfm	(working copy)
    @@ -13,7 +13,7 @@
       OnCreate = FormCreate
       OnDeactivate = FormDeactivate
       PopupMode = pmAuto
    -  LCLVersion = '1.5'
    +  LCLVersion = '1.7'
       object MainPanel: TPanel
         Left = 0
         Height = 185
    Index: lcl/forms/timepopup.pas
    ===================================================================
    --- lcl/forms/timepopup.pas	(revision 52101)
    +++ lcl/forms/timepopup.pas	(working copy)
    @@ -41,6 +41,7 @@
         FOnReturnTime: TReturnTimeEvent;
         FSimpleLayout: Boolean;
         FPopupOrigin: TPoint;
    +    FCaller: TControl;
         procedure ActivateDoubleBuffered;
         procedure CalcGridHeights;
         function GetTime: TDateTime;
    @@ -56,18 +57,22 @@
       end;
     
     procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean;
    -                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent = nil; SimpleLayout: Boolean = True);
    +                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent = nil;
    +                        SimpleLayout: Boolean = True; ACaller: TControl = nil);
     
     implementation
     
     {$R *.lfm}
     
    -procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean; const OnReturnTime: TReturnTimeEvent;
    -                        const OnShowHide: TNotifyEvent; SimpleLayout: Boolean);
    +procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean;
    +                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent;
    +                        SimpleLayout: Boolean; ACaller: TControl);
     var
       NewForm: TTimePopupForm;
    +  P: TPoint;
     begin
       NewForm := TTimePopupForm.Create(nil);
    +  NewForm.FCaller := ACaller;
       NewForm.Initialize(Position, ATime);
       NewForm.FOnReturnTime := OnReturnTime;
       NewForm.OnShow := OnShowHide;
    @@ -78,7 +83,11 @@
       if not SimpleLayout then
         NewForm.SetTime(ATime); //update the row and col in the grid;
       NewForm.Show;
    -  NewForm.KeepInView(Position);
    +  if Assigned(ACaller) then
    +    P := ACaller.ControlToScreen(Point(0, ACaller.Height))
    +  else
    +    P := Position;
    +  NewForm.KeepInView(P);
     end;
     
     procedure TTimePopupForm.SetTime(ATime: TDateTime);
    @@ -89,6 +98,7 @@
       Minute := MinuteOf(ATime);
       HoursGrid.Col := Hour mod 12;
       HoursGrid.Row := Hour div 12;
    +  HoursGrid.TopRow := 0;  // Avoid morning hours scrolling out of view if time is > 12:00
       if FSimpleLayout then
       begin
         Minute := Minute - (Minute mod 5);
    @@ -259,17 +269,25 @@
     var
       ABounds: TRect;
     begin
    -  ABounds := Screen.MonitorFromPoint(PopupOrigin).BoundsRect;
    +  ABounds := Screen.MonitorFromPoint(PopupOrigin).WorkAreaRect; // take care of taskbar
    +
       if PopupOrigin.X + Width > ABounds.Right then
         Left := ABounds.Right - Width
    +  else if PopupOrigin.X < ABounds.Left then
    +    Left := ABounds.Left
       else
         Left := PopupOrigin.X;
    +
       if PopupOrigin.Y + Height > ABounds.Bottom then
    -    Top := ABounds.Bottom - Height
    +  begin
    +    if Assigned(FCaller) then
    +      Top := PopupOrigin.Y - FCaller.Height - Height
    +    else
    +      Top := ABounds.Bottom - Height;
    +  end else if PopupOrigin.Y < ABounds.Top then
    +    Top := ABounds.Top
       else
         Top := PopupOrigin.Y;
    -  //store the fitting point, so the form won't move if it layout is changed back to simple
    -  FPopupOrigin := Point(Left, Top);
     end;
     
     procedure TTimePopupForm.ReturnTime;
    
    TTimeEdit-v3.patch (8,265 bytes)
  • TDateTimeEdit-v4.patch (8,207 bytes)
    Index: lcl/editbtn.pas
    ===================================================================
    --- lcl/editbtn.pas	(revision 52101)
    +++ lcl/editbtn.pas	(working copy)
    @@ -1597,7 +1597,7 @@
       if ADate = NullDate then
         ADate := SysUtils.Date;
       ShowCalendarPopup(PopupOrigin, ADate, CalendarDisplaySettings,
    -                    @CalendarPopupReturnDate, @CalendarPopupShowHide);
    +                    @CalendarPopupReturnDate, @CalendarPopupShowHide, self);
       //Do this after the dialog, otherwise it just looks silly
       if FocusOnButtonClick then FocusAndMaybeSelectAll;
     end;
    @@ -2092,7 +2092,8 @@
       ATime := GetTime;
       if ATime = NullDate then
         ATime := SysUtils.Time;
    -  ShowTimePopup(PopupOrigin, ATime, Self.DoubleBuffered, @TimePopupReturnTime, @TimePopupShowHide, FSimpleLayout);
    +  ShowTimePopup(PopupOrigin, ATime, Self.DoubleBuffered, @TimePopupReturnTime,
    +    @TimePopupShowHide, FSimpleLayout, self);
     end;
     
     function TTimeEdit.TryParseInput(AInput: String; out ParseResult: TDateTime): Boolean;
    Index: lcl/forms/calendarpopup.lfm
    ===================================================================
    --- lcl/forms/calendarpopup.lfm	(revision 52101)
    +++ lcl/forms/calendarpopup.lfm	(working copy)
    @@ -13,17 +13,17 @@
       OnCreate = FormCreate
       OnDeactivate = FormDeactivate
       PopupMode = pmAuto
    -  LCLVersion = '0.9.31'
    +  LCLVersion = '1.7'
       object Calendar: TCalendar
    -    Left = 1
    -    Height = 176
    -    Top = 1
    -    Width = 177
    -    AutoSize = True
    +    Left = 0
    +    Height = 160
    +    Top = 0
    +    Width = 176
         BorderSpacing.Around = 1
         DateTime = 38823
         OnDblClick = CalendarDblClick
         OnKeyDown = CalendarKeyDown
    +    TabOrder = 0
         TabStop = True
       end
     end
    Index: lcl/forms/calendarpopup.pas
    ===================================================================
    --- lcl/forms/calendarpopup.pas	(revision 52101)
    +++ lcl/forms/calendarpopup.pas	(working copy)
    @@ -37,6 +37,7 @@
       private
         FClosed: boolean;
         FOnReturnDate: TReturnDateEvent;
    +    FCaller: TControl;
         procedure Initialize(const PopupOrigin: TPoint; ADate: TDateTime;
                              const DisplaySettings: TDisplaySettings);
         procedure ReturnDate;
    @@ -46,7 +47,8 @@
     
     procedure ShowCalendarPopup(const Position: TPoint; ADate: TDateTime;
         const CalendarDisplaySettings: TDisplaySettings;
    -    const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil);
    +    const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil;
    +    ACaller: TControl = nil);
     
     implementation
     
    @@ -54,11 +56,13 @@
     
     procedure ShowCalendarPopup(const Position: TPoint; ADate: TDateTime;
       const CalendarDisplaySettings: TDisplaySettings;
    -  const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil);
    +  const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent;
    +  ACaller: TControl);
     var
       PopupForm: TCalendarPopupForm;
     begin
       PopupForm := TCalendarPopupForm.Create(nil);
    +  PopupForm.FCaller := ACaller;
       PopupForm.Initialize(Position, ADate, CalendarDisplaySettings);
       PopupForm.FOnReturnDate := OnReturnDate;
       PopupForm.OnShow := OnShowHide;
    @@ -71,6 +75,8 @@
     procedure TCalendarPopupForm.FormCreate(Sender: TObject);
     begin
       FClosed := false;
    +  ClientWidth := Calendar.Width + 2*Calendar.Left;
    +  ClientHeight := Calendar.Height + 2*Calendar.Top;
       Application.AddOnDeactivateHandler(@FormDeactivate);
     end;
     
    @@ -131,18 +137,34 @@
       ADate: TDateTime; const DisplaySettings: TDisplaySettings);
     var
       ABounds: TRect;
    +  P: TPoint;
     begin
    -  ABounds := Screen.MonitorFromPoint(PopupOrigin).BoundsRect;
    -  if PopupOrigin.X + Width > ABounds.Right then
    +  Calendar.DateTime := ADate;
    +  Calendar.DisplaySettings:=DisplaySettings;
    +
    +  if Assigned(FCaller) then
    +    P := FCaller.ControlToScreen(Point(0, FCaller.Height))
    +  else
    +    P := PopupOrigin;
    +
    +  ABounds := Screen.MonitorFromPoint(P).WorkAreaRect;
    +  if P.X + Width > ABounds.Right then
         Left := ABounds.Right - Width
    +  else if P.X < ABounds.Left then
    +    Left := ABounds.Left
       else
    -    Left := PopupOrigin.X;
    -  if PopupOrigin.Y + Height > ABounds.Bottom then
    -    Top := ABounds.Bottom - Height
    +    Left := P.X;
    +
    +  if P.Y + Height > ABounds.Bottom then
    +  begin
    +    if Assigned(FCaller) then
    +      Top := P.Y - FCaller.Height - Height
    +    else
    +      Top := ABounds.Bottom - Height;
    +  end else if P.Y < ABounds.Top then
    +    Top := ABounds.Top
       else
         Top := PopupOrigin.Y;
    -  Calendar.DateTime := ADate;
    -  Calendar.DisplaySettings:=DisplaySettings;
     end;
     
     procedure TCalendarPopupForm.ReturnDate;
    Index: lcl/forms/timepopup.lfm
    ===================================================================
    --- lcl/forms/timepopup.lfm	(revision 52101)
    +++ lcl/forms/timepopup.lfm	(working copy)
    @@ -13,7 +13,7 @@
       OnCreate = FormCreate
       OnDeactivate = FormDeactivate
       PopupMode = pmAuto
    -  LCLVersion = '1.5'
    +  LCLVersion = '1.7'
       object MainPanel: TPanel
         Left = 0
         Height = 185
    Index: lcl/forms/timepopup.pas
    ===================================================================
    --- lcl/forms/timepopup.pas	(revision 52101)
    +++ lcl/forms/timepopup.pas	(working copy)
    @@ -41,6 +41,7 @@
         FOnReturnTime: TReturnTimeEvent;
         FSimpleLayout: Boolean;
         FPopupOrigin: TPoint;
    +    FCaller: TControl;
         procedure ActivateDoubleBuffered;
         procedure CalcGridHeights;
         function GetTime: TDateTime;
    @@ -56,18 +57,22 @@
       end;
     
     procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean;
    -                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent = nil; SimpleLayout: Boolean = True);
    +                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent = nil;
    +                        SimpleLayout: Boolean = True; ACaller: TControl = nil);
     
     implementation
     
     {$R *.lfm}
     
    -procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean; const OnReturnTime: TReturnTimeEvent;
    -                        const OnShowHide: TNotifyEvent; SimpleLayout: Boolean);
    +procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean;
    +                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent;
    +                        SimpleLayout: Boolean; ACaller: TControl);
     var
       NewForm: TTimePopupForm;
    +  P: TPoint;
     begin
       NewForm := TTimePopupForm.Create(nil);
    +  NewForm.FCaller := ACaller;
       NewForm.Initialize(Position, ATime);
       NewForm.FOnReturnTime := OnReturnTime;
       NewForm.OnShow := OnShowHide;
    @@ -78,7 +83,11 @@
       if not SimpleLayout then
         NewForm.SetTime(ATime); //update the row and col in the grid;
       NewForm.Show;
    -  NewForm.KeepInView(Position);
    +  if Assigned(ACaller) then
    +    P := ACaller.ControlToScreen(Point(0, ACaller.Height))
    +  else
    +    P := Position;
    +  NewForm.KeepInView(P);
     end;
     
     procedure TTimePopupForm.SetTime(ATime: TDateTime);
    @@ -89,6 +98,7 @@
       Minute := MinuteOf(ATime);
       HoursGrid.Col := Hour mod 12;
       HoursGrid.Row := Hour div 12;
    +  HoursGrid.TopRow := 0;  // Avoid morning hours scrolling out of view if time is > 12:00
       if FSimpleLayout then
       begin
         Minute := Minute - (Minute mod 5);
    @@ -259,17 +269,25 @@
     var
       ABounds: TRect;
     begin
    -  ABounds := Screen.MonitorFromPoint(PopupOrigin).BoundsRect;
    +  ABounds := Screen.MonitorFromPoint(PopupOrigin).WorkAreaRect; // take care of taskbar
    +
       if PopupOrigin.X + Width > ABounds.Right then
         Left := ABounds.Right - Width
    +  else if PopupOrigin.X < ABounds.Left then
    +    Left := ABounds.Left
       else
         Left := PopupOrigin.X;
    +
       if PopupOrigin.Y + Height > ABounds.Bottom then
    -    Top := ABounds.Bottom - Height
    +  begin
    +    if Assigned(FCaller) then
    +      Top := PopupOrigin.Y - FCaller.Height - Height
    +    else
    +      Top := ABounds.Bottom - Height;
    +  end else if PopupOrigin.Y < ABounds.Top then
    +    Top := ABounds.Top
       else
         Top := PopupOrigin.Y;
    -  //store the fitting point, so the form won't move if it layout is changed back to simple
    -  FPopupOrigin := Point(Left, Top);
     end;
     
     procedure TTimePopupForm.ReturnTime;
    
    TDateTimeEdit-v4.patch (8,207 bytes)
  • TTimeEdit-v5.patch (4,205 bytes)
    Index: lcl/editbtn.pas
    ===================================================================
    --- lcl/editbtn.pas	(revision 52105)
    +++ lcl/editbtn.pas	(working copy)
    @@ -2092,7 +2092,8 @@
       ATime := GetTime;
       if ATime = NullDate then
         ATime := SysUtils.Time;
    -  ShowTimePopup(PopupOrigin, ATime, Self.DoubleBuffered, @TimePopupReturnTime, @TimePopupShowHide, FSimpleLayout);
    +  ShowTimePopup(PopupOrigin, ATime, Self.DoubleBuffered,
    +    @TimePopupReturnTime, @TimePopupShowHide, FSimpleLayout, self);
     end;
     
     function TTimeEdit.TryParseInput(AInput: String; out ParseResult: TDateTime): Boolean;
    Index: lcl/forms/timepopup.lfm
    ===================================================================
    --- lcl/forms/timepopup.lfm	(revision 52105)
    +++ lcl/forms/timepopup.lfm	(working copy)
    @@ -13,7 +13,7 @@
       OnCreate = FormCreate
       OnDeactivate = FormDeactivate
       PopupMode = pmAuto
    -  LCLVersion = '1.5'
    +  LCLVersion = '1.7'
       object MainPanel: TPanel
         Left = 0
         Height = 185
    Index: lcl/forms/timepopup.pas
    ===================================================================
    --- lcl/forms/timepopup.pas	(revision 52105)
    +++ lcl/forms/timepopup.pas	(working copy)
    @@ -41,6 +41,7 @@
         FOnReturnTime: TReturnTimeEvent;
         FSimpleLayout: Boolean;
         FPopupOrigin: TPoint;
    +    FCaller: TControl;
         procedure ActivateDoubleBuffered;
         procedure CalcGridHeights;
         function GetTime: TDateTime;
    @@ -56,18 +57,22 @@
       end;
     
     procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean;
    -                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent = nil; SimpleLayout: Boolean = True);
    +                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent = nil;
    +                        SimpleLayout: Boolean = True; ACaller: TControl = nil);
     
     implementation
     
     {$R *.lfm}
     
    -procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean; const OnReturnTime: TReturnTimeEvent;
    -                        const OnShowHide: TNotifyEvent; SimpleLayout: Boolean);
    +procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean;
    +                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent;
    +                        SimpleLayout: Boolean; ACaller: TControl);
     var
       NewForm: TTimePopupForm;
    +  P: TPoint;
     begin
       NewForm := TTimePopupForm.Create(nil);
    +  NewForm.FCaller := ACaller;
       NewForm.Initialize(Position, ATime);
       NewForm.FOnReturnTime := OnReturnTime;
       NewForm.OnShow := OnShowHide;
    @@ -78,7 +83,11 @@
       if not SimpleLayout then
         NewForm.SetTime(ATime); //update the row and col in the grid;
       NewForm.Show;
    -  NewForm.KeepInView(Position);
    +  if Assigned(ACaller) then
    +    P := ACaller.ControlToScreen(Point(0, ACaller.Height))
    +  else
    +    P := Position;
    +  NewForm.KeepInView(P);
     end;
     
     procedure TTimePopupForm.SetTime(ATime: TDateTime);
    @@ -89,6 +98,7 @@
       Minute := MinuteOf(ATime);
       HoursGrid.Col := Hour mod 12;
       HoursGrid.Row := Hour div 12;
    +  HoursGrid.TopRow := 0;  // Avoid morning hours scrolling out of view if time is > 12:00
       if FSimpleLayout then
       begin
         Minute := Minute - (Minute mod 5);
    @@ -259,17 +269,25 @@
     var
       ABounds: TRect;
     begin
    -  ABounds := Screen.MonitorFromPoint(PopupOrigin).BoundsRect;
    +  ABounds := Screen.MonitorFromPoint(PopupOrigin).WorkAreaRect; // take care of taskbar
    +
       if PopupOrigin.X + Width > ABounds.Right then
         Left := ABounds.Right - Width
    +  else if PopupOrigin.X < ABounds.Left then
    +    Left := ABounds.Left
       else
         Left := PopupOrigin.X;
    +
       if PopupOrigin.Y + Height > ABounds.Bottom then
    -    Top := ABounds.Bottom - Height
    +  begin
    +    if Assigned(FCaller) then
    +      Top := PopupOrigin.Y - FCaller.Height - Height
    +    else
    +      Top := ABounds.Bottom - Height;
    +  end else if PopupOrigin.Y < ABounds.Top then
    +    Top := ABounds.Top
       else
         Top := PopupOrigin.Y;
    -  //store the fitting point, so the form won't move if it layout is changed back to simple
    -  FPopupOrigin := Point(Left, Top);
     end;
     
     procedure TTimePopupForm.ReturnTime;
    
    TTimeEdit-v5.patch (4,205 bytes)
  • timedit-offscreen.png (82,153 bytes)
    timedit-offscreen.png (82,153 bytes)
  • TDateEdit-v6.patch (5,415 bytes)
    Index: lcl/editbtn.pas
    ===================================================================
    --- lcl/editbtn.pas	(revision 52106)
    +++ lcl/editbtn.pas	(working copy)
    @@ -1597,7 +1597,7 @@
       if ADate = NullDate then
         ADate := SysUtils.Date;
       ShowCalendarPopup(PopupOrigin, ADate, CalendarDisplaySettings,
    -                    @CalendarPopupReturnDate, @CalendarPopupShowHide);
    +                    @CalendarPopupReturnDate, @CalendarPopupShowHide, self);
       //Do this after the dialog, otherwise it just looks silly
       if FocusOnButtonClick then FocusAndMaybeSelectAll;
     end;
    Index: lcl/forms/calendarpopup.lfm
    ===================================================================
    --- lcl/forms/calendarpopup.lfm	(revision 52106)
    +++ lcl/forms/calendarpopup.lfm	(working copy)
    @@ -13,17 +13,17 @@
       OnCreate = FormCreate
       OnDeactivate = FormDeactivate
       PopupMode = pmAuto
    -  LCLVersion = '0.9.31'
    +  LCLVersion = '1.7'
       object Calendar: TCalendar
    -    Left = 1
    -    Height = 176
    -    Top = 1
    -    Width = 177
    +    Left = 0
    +    Height = 160
    +    Top = 0
    +    Width = 176
         AutoSize = True
    -    BorderSpacing.Around = 1
         DateTime = 38823
         OnDblClick = CalendarDblClick
         OnKeyDown = CalendarKeyDown
    +    TabOrder = 0
         TabStop = True
       end
     end
    Index: lcl/forms/calendarpopup.pas
    ===================================================================
    --- lcl/forms/calendarpopup.pas	(revision 52106)
    +++ lcl/forms/calendarpopup.pas	(working copy)
    @@ -20,7 +20,8 @@
     interface
     
     uses
    -  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Calendar, LCLProc, LCLType;
    +  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Calendar, LCLProc,
    +  LCLType;
       
     type
       TReturnDateEvent = procedure (Sender: TObject; const Date: TDateTime) of object;
    @@ -37,33 +38,42 @@
       private
         FClosed: boolean;
         FOnReturnDate: TReturnDateEvent;
    +    FCaller: TControl;
    +    FPopupOrigin: TPoint;
         procedure Initialize(const PopupOrigin: TPoint; ADate: TDateTime;
                              const DisplaySettings: TDisplaySettings);
    +    procedure KeepInView;
         procedure ReturnDate;
    -  protected
    -    procedure Paint; override;
       end;
     
     procedure ShowCalendarPopup(const Position: TPoint; ADate: TDateTime;
         const CalendarDisplaySettings: TDisplaySettings;
    -    const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil);
    +    const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil;
    +    ACaller: TControl = nil);
     
     implementation
     
    +{$IFDEF WINDOWS}
    +uses Themes;
    +{$ENDIF}
    +
     {$R *.lfm}
     
     procedure ShowCalendarPopup(const Position: TPoint; ADate: TDateTime;
       const CalendarDisplaySettings: TDisplaySettings;
    -  const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil);
    +  const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent;
    +  ACaller: TControl);
     var
       PopupForm: TCalendarPopupForm;
     begin
       PopupForm := TCalendarPopupForm.Create(nil);
    +  PopupForm.FCaller := ACaller;
       PopupForm.Initialize(Position, ADate, CalendarDisplaySettings);
       PopupForm.FOnReturnDate := OnReturnDate;
       PopupForm.OnShow := OnShowHide;
       PopupForm.OnHide := OnShowHide;
       PopupForm.Show;
    +  PopupForm.KeepInView;
     end;
     
     { TCalendarPopupForm }
    @@ -72,6 +82,14 @@
     begin
       FClosed := false;
       Application.AddOnDeactivateHandler(@FormDeactivate);
    +  { Make sure that there is a border around the popup calendar in unthemed
    +    Windows because the calendar is borderless in this case. }
    +  {$IFDEF WINDOWS}
    +  if not ThemeServices.ThemesEnabled then begin
    +    Color := clWindowFrame;
    +    Calendar.BorderSpacing.Around := 1;
    +  end;
    +  {$ENDIF}
     end;
     
     procedure TCalendarPopupForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
    @@ -129,20 +147,36 @@
     
     procedure TCalendarPopupForm.Initialize(const PopupOrigin: TPoint;
       ADate: TDateTime; const DisplaySettings: TDisplaySettings);
    +begin
    +  Calendar.DateTime := ADate;
    +  Calendar.DisplaySettings:=DisplaySettings;
    +  FPopupOrigin := PopupOrigin;
    +end;
    +
    +procedure TCalendarPopupForm.KeepInView;
     var
       ABounds: TRect;
    +  P: TPoint;
     begin
    -  ABounds := Screen.MonitorFromPoint(PopupOrigin).BoundsRect;
    -  if PopupOrigin.X + Width > ABounds.Right then
    +  ABounds := Screen.MonitorFromPoint(FPopupOrigin).WorkAreaRect; // take care of taskbar
    +  if FPopupOrigin.X + Width > ABounds.Right then
         Left := ABounds.Right - Width
    +  else if FPopupOrigin.X < ABounds.Left then
    +    Left := ABounds.Left
       else
    -    Left := PopupOrigin.X;
    -  if PopupOrigin.Y + Height > ABounds.Bottom then
    -    Top := ABounds.Bottom - Height
    +    Left := FPopupOrigin.X;
    +  if FPopupOrigin.Y + Height > ABounds.Bottom then
    +  begin
    +    if Assigned(FCaller) then
    +      Top := FPopupOrigin.Y - FCaller.Height - Height
    +    else
    +      Top := ABounds.Bottom - Height;
    +  end else if FPopupOrigin.Y < ABounds.Top then
    +    Top := ABounds.Top
       else
    -    Top := PopupOrigin.Y;
    -  Calendar.DateTime := ADate;
    -  Calendar.DisplaySettings:=DisplaySettings;
    +    Top := FPopupOrigin.Y;
    +  if Left < ABounds.Left then Left := 0;
    +  if Top < ABounds.Top then Top := 0;
     end;
     
     procedure TCalendarPopupForm.ReturnDate;
    @@ -153,12 +187,4 @@
         Close;
     end;
     
    -procedure TCalendarPopupForm.Paint;
    -begin
    -  inherited Paint;
    -  Canvas.Pen.Color := clWindowText;
    -  Canvas.Pen.Style := psSolid;
    -  Canvas.Rectangle(0, 0, Width-1, Height-1);
    -end;
    -
     end.
    
    TDateEdit-v6.patch (5,415 bytes)
  • TDateEdit-v7.patch (4,592 bytes)
    Index: lcl/editbtn.pas
    ===================================================================
    --- lcl/editbtn.pas	(revision 52114)
    +++ lcl/editbtn.pas	(working copy)
    @@ -1597,7 +1597,7 @@
       if ADate = NullDate then
         ADate := SysUtils.Date;
       ShowCalendarPopup(PopupOrigin, ADate, CalendarDisplaySettings,
    -                    @CalendarPopupReturnDate, @CalendarPopupShowHide);
    +                    @CalendarPopupReturnDate, @CalendarPopupShowHide, self);
       //Do this after the dialog, otherwise it just looks silly
       if FocusOnButtonClick then FocusAndMaybeSelectAll;
     end;
    Index: lcl/forms/calendarpopup.lfm
    ===================================================================
    --- lcl/forms/calendarpopup.lfm	(revision 52114)
    +++ lcl/forms/calendarpopup.lfm	(working copy)
    @@ -13,17 +13,18 @@
       OnCreate = FormCreate
       OnDeactivate = FormDeactivate
       PopupMode = pmAuto
    -  LCLVersion = '0.9.31'
    +  LCLVersion = '1.7'
       object Calendar: TCalendar
         Left = 1
    -    Height = 176
    +    Height = 160
         Top = 1
    -    Width = 177
    +    Width = 176
         AutoSize = True
         BorderSpacing.Around = 1
         DateTime = 38823
         OnDblClick = CalendarDblClick
         OnKeyDown = CalendarKeyDown
    +    TabOrder = 0
         TabStop = True
       end
     end
    Index: lcl/forms/calendarpopup.pas
    ===================================================================
    --- lcl/forms/calendarpopup.pas	(revision 52114)
    +++ lcl/forms/calendarpopup.pas	(working copy)
    @@ -35,10 +35,12 @@
         procedure FormCreate(Sender: TObject);
         procedure FormDeactivate(Sender: TObject);
       private
    +    FCaller: TControl;
         FClosed: boolean;
         FOnReturnDate: TReturnDateEvent;
    -    procedure Initialize(const PopupOrigin: TPoint; ADate: TDateTime;
    -                         const DisplaySettings: TDisplaySettings);
    +    procedure Initialize(ADate: TDateTime;
    +      const DisplaySettings: TDisplaySettings);
    +    procedure KeepInView(const PopupOrigin: TPoint);
         procedure ReturnDate;
       protected
         procedure Paint; override;
    @@ -46,7 +48,8 @@
     
     procedure ShowCalendarPopup(const Position: TPoint; ADate: TDateTime;
         const CalendarDisplaySettings: TDisplaySettings;
    -    const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil);
    +    const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil;
    +    ACaller: TControl = nil);
     
     implementation
     
    @@ -54,16 +57,19 @@
     
     procedure ShowCalendarPopup(const Position: TPoint; ADate: TDateTime;
       const CalendarDisplaySettings: TDisplaySettings;
    -  const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil);
    +  const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent;
    +  ACaller: TControl);
     var
       PopupForm: TCalendarPopupForm;
     begin
       PopupForm := TCalendarPopupForm.Create(nil);
    -  PopupForm.Initialize(Position, ADate, CalendarDisplaySettings);
    +  PopupForm.FCaller := ACaller;
    +  PopupForm.Initialize(ADate, CalendarDisplaySettings);
       PopupForm.FOnReturnDate := OnReturnDate;
       PopupForm.OnShow := OnShowHide;
       PopupForm.OnHide := OnShowHide;
       PopupForm.Show;
    +  PopupForm.KeepInView(Position);   // must be after Show for PopupForm.AutoSize to be in effect.
     end;
     
     { TCalendarPopupForm }
    @@ -127,22 +133,37 @@
         Close;
     end;
     
    -procedure TCalendarPopupForm.Initialize(const PopupOrigin: TPoint;
    -  ADate: TDateTime; const DisplaySettings: TDisplaySettings);
    +procedure TCalendarPopupForm.Initialize(ADate: TDateTime;
    +  const DisplaySettings: TDisplaySettings);
    +begin
    +  Calendar.DateTime := ADate;
    +  Calendar.DisplaySettings:=DisplaySettings;
    +end;
    +
    +procedure TCalendarPopupForm.KeepInView(const PopupOrigin: TPoint);
     var
       ABounds: TRect;
    +  P: TPoint;
     begin
    -  ABounds := Screen.MonitorFromPoint(PopupOrigin).BoundsRect;
    +  ABounds := Screen.MonitorFromPoint(PopupOrigin).WorkAreaRect; // take care of taskbar
       if PopupOrigin.X + Width > ABounds.Right then
         Left := ABounds.Right - Width
    +  else if PopupOrigin.X < ABounds.Left then
    +    Left := ABounds.Left
       else
         Left := PopupOrigin.X;
       if PopupOrigin.Y + Height > ABounds.Bottom then
    -    Top := ABounds.Bottom - Height
    +  begin
    +    if Assigned(FCaller) then
    +      Top := PopupOrigin.Y - FCaller.Height - Height
    +    else
    +      Top := ABounds.Bottom - Height;
    +  end else if PopupOrigin.Y < ABounds.Top then
    +    Top := ABounds.Top
       else
         Top := PopupOrigin.Y;
    -  Calendar.DateTime := ADate;
    -  Calendar.DisplaySettings:=DisplaySettings;
    +  if Left < ABounds.Left then Left := 0;
    +  if Top < ABounds.Top then Top := 0;
     end;
     
     procedure TCalendarPopupForm.ReturnDate;
    
    TDateEdit-v7.patch (4,592 bytes)
  • TDateEdit-v8.patch (892 bytes)
    Index: lcl/forms/calendarpopup.lfm
    ===================================================================
    --- lcl/forms/calendarpopup.lfm	(revision 52118)
    +++ lcl/forms/calendarpopup.lfm	(working copy)
    @@ -15,10 +15,10 @@
       PopupMode = pmAuto
       LCLVersion = '1.7'
       object Calendar: TCalendar
    -    Left = 1
    +    Left = 0
         Height = 160
    -    Top = 1
    -    Width = 169
    +    Top = 0
    +    Width = 176
         AutoSize = True
         BorderSpacing.Around = 1
         DateTime = 38823
    Index: lcl/forms/calendarpopup.pas
    ===================================================================
    --- lcl/forms/calendarpopup.pas	(revision 52118)
    +++ lcl/forms/calendarpopup.pas	(working copy)
    @@ -179,7 +179,7 @@
       inherited Paint;
       Canvas.Pen.Color := clWindowText;
       Canvas.Pen.Style := psSolid;
    -  Canvas.Rectangle(0, 0, Width-1, Height-1);
    +  Canvas.Rectangle(0, 0, Width, Height);
     end;
     
     end.
    
    TDateEdit-v8.patch (892 bytes)

Relationships

has duplicate 0030104 resolvedZeljan Rikalo TTimeEdit wrong hours showing 

Activities

wp

2016-04-02 23:02

developer  

TTimeEdit.patch (3,555 bytes)
Index: lcl/editbtn.pas
===================================================================
--- lcl/editbtn.pas	(revision 52101)
+++ lcl/editbtn.pas	(working copy)
@@ -2092,7 +2092,7 @@
   ATime := GetTime;
   if ATime = NullDate then
     ATime := SysUtils.Time;
-  ShowTimePopup(PopupOrigin, ATime, Self.DoubleBuffered, @TimePopupReturnTime, @TimePopupShowHide, FSimpleLayout);
+  ShowTimePopup(PopupOrigin, ATime, Height, Self.DoubleBuffered, @TimePopupReturnTime, @TimePopupShowHide, FSimpleLayout);
 end;
 
 function TTimeEdit.TryParseInput(AInput: String; out ParseResult: TDateTime): Boolean;
Index: lcl/forms/timepopup.lfm
===================================================================
--- lcl/forms/timepopup.lfm	(revision 52101)
+++ lcl/forms/timepopup.lfm	(working copy)
@@ -13,7 +13,7 @@
   OnCreate = FormCreate
   OnDeactivate = FormDeactivate
   PopupMode = pmAuto
-  LCLVersion = '1.5'
+  LCLVersion = '1.7'
   object MainPanel: TPanel
     Left = 0
     Height = 185
Index: lcl/forms/timepopup.pas
===================================================================
--- lcl/forms/timepopup.pas	(revision 52101)
+++ lcl/forms/timepopup.pas	(working copy)
@@ -41,6 +41,7 @@
     FOnReturnTime: TReturnTimeEvent;
     FSimpleLayout: Boolean;
     FPopupOrigin: TPoint;
+    FEditHeight: Integer;
     procedure ActivateDoubleBuffered;
     procedure CalcGridHeights;
     function GetTime: TDateTime;
@@ -55,7 +56,7 @@
     procedure FormDeactivate(Sender: TObject);
   end;
 
-procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean;
+procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const EditHeight: Integer; const DoubleBufferedForm: Boolean;
                         const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent = nil; SimpleLayout: Boolean = True);
 
 implementation
@@ -62,7 +63,7 @@
 
 {$R *.lfm}
 
-procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean; const OnReturnTime: TReturnTimeEvent;
+procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const EditHeight: Integer; const DoubleBufferedForm: Boolean; const OnReturnTime: TReturnTimeEvent;
                         const OnShowHide: TNotifyEvent; SimpleLayout: Boolean);
 var
   NewForm: TTimePopupForm;
@@ -69,6 +70,7 @@
 begin
   NewForm := TTimePopupForm.Create(nil);
   NewForm.Initialize(Position, ATime);
+  NewForm.FEditHeight := EditHeight;
   NewForm.FOnReturnTime := OnReturnTime;
   NewForm.OnShow := OnShowHide;
   NewForm.OnHide := OnShowHide;
@@ -89,6 +91,7 @@
   Minute := MinuteOf(ATime);
   HoursGrid.Col := Hour mod 12;
   HoursGrid.Row := Hour div 12;
+  HoursGrid.TopRow := 0;  // Avoid morning hours scrolling out of view if time is > 12:00
   if FSimpleLayout then
   begin
     Minute := Minute - (Minute mod 5);
@@ -259,17 +262,15 @@
 var
   ABounds: TRect;
 begin
-  ABounds := Screen.MonitorFromPoint(PopupOrigin).BoundsRect;
+  ABounds := Screen.MonitorFromPoint(PopupOrigin).WorkAreaRect; // take care of taskbar!
   if PopupOrigin.X + Width > ABounds.Right then
     Left := ABounds.Right - Width
   else
     Left := PopupOrigin.X;
   if PopupOrigin.Y + Height > ABounds.Bottom then
-    Top := ABounds.Bottom - Height
+    Top := PopupOrigin.Y - FEditHeight - Height
   else
     Top := PopupOrigin.Y;
-  //store the fitting point, so the form won't move if it layout is changed back to simple
-  FPopupOrigin := Point(Left, Top);
 end;
 
 procedure TTimePopupForm.ReturnTime;
TTimeEdit.patch (3,555 bytes)

wp

2016-04-02 23:05

developer  

TimeEdit-BugReport-29949.zip (2,085 bytes)

wp

2016-04-02 23:12

developer  

TTimeEdit-before.png (67,475 bytes)
TTimeEdit-before.png (67,475 bytes)

wp

2016-04-02 23:13

developer  

TTimeEdit-after.png (70,184 bytes)
TTimeEdit-after.png (70,184 bytes)

Bart Broersma

2016-04-02 23:58

developer   ~0091685

The patch will break existing programs I think?
(You changed th signature of ShowTimePopup)

wp

2016-04-03 01:12

developer   ~0091686

Last edited: 2016-04-03 04:15

View 2 revisions

Yes, but will really anybody call this alone without the TTimeEdit?

Anyway, I could deprecate the old procedure and overload it with the new one.

wp

2016-04-03 10:49

developer  

TTimeEdit-v2.patch (4,569 bytes)
Index: lcl/editbtn.pas
===================================================================
--- lcl/editbtn.pas	(revision 52101)
+++ lcl/editbtn.pas	(working copy)
@@ -2092,7 +2092,7 @@
   ATime := GetTime;
   if ATime = NullDate then
     ATime := SysUtils.Time;
-  ShowTimePopup(PopupOrigin, ATime, Self.DoubleBuffered, @TimePopupReturnTime, @TimePopupShowHide, FSimpleLayout);
+  ShowTimePopup(PopupOrigin, -Height, ATime, Self.DoubleBuffered, @TimePopupReturnTime, @TimePopupShowHide, FSimpleLayout);
 end;
 
 function TTimeEdit.TryParseInput(AInput: String; out ParseResult: TDateTime): Boolean;
Index: lcl/forms/timepopup.lfm
===================================================================
--- lcl/forms/timepopup.lfm	(revision 52101)
+++ lcl/forms/timepopup.lfm	(working copy)
@@ -13,7 +13,7 @@
   OnCreate = FormCreate
   OnDeactivate = FormDeactivate
   PopupMode = pmAuto
-  LCLVersion = '1.5'
+  LCLVersion = '1.7'
   object MainPanel: TPanel
     Left = 0
     Height = 185
Index: lcl/forms/timepopup.pas
===================================================================
--- lcl/forms/timepopup.pas	(revision 52101)
+++ lcl/forms/timepopup.pas	(working copy)
@@ -41,6 +41,7 @@
     FOnReturnTime: TReturnTimeEvent;
     FSimpleLayout: Boolean;
     FPopupOrigin: TPoint;
+    FAltPopupOriginDeltaY: Integer;
     procedure ActivateDoubleBuffered;
     procedure CalcGridHeights;
     function GetTime: TDateTime;
@@ -57,18 +58,35 @@
 
 procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean;
                         const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent = nil; SimpleLayout: Boolean = True);
+                        overload; deprecated 'Use overloaded version with "AltPositionDeltaY"';
 
+procedure ShowTimePopup(const Position: TPoint; AltPositionDeltaY: Integer; ATime: TDateTime; const DoubleBufferedForm: Boolean;
+                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent = nil; SimpleLayout: Boolean = True);
+                        overload;
+
 implementation
 
 {$R *.lfm}
 
-procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean; const OnReturnTime: TReturnTimeEvent;
+procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime;
+                        const DoubleBufferedForm: Boolean; const OnReturnTime: TReturnTimeEvent;
                         const OnShowHide: TNotifyEvent; SimpleLayout: Boolean);
+begin
+  // AltPositionDeltaY = MaxInt puts the popup at the lowest position possible,
+  // like in Laz 1.6 and older (--> overlaps the edit)
+  ShowTimePopup(Position, MaxInt, ATime, DoubleBufferedForm, OnReturnTime,
+    OnShowHide, SimpleLayout);
+end;
+
+procedure ShowTimePopup(const Position: TPoint; AltPositionDeltaY: Integer; ATime: TDateTime;
+                        const DoubleBufferedForm: Boolean; const OnReturnTime: TReturnTimeEvent;
+                        const OnShowHide: TNotifyEvent; SimpleLayout: Boolean);
 var
   NewForm: TTimePopupForm;
 begin
   NewForm := TTimePopupForm.Create(nil);
   NewForm.Initialize(Position, ATime);
+  NewForm.FAltPopupOriginDeltaY := AltPositionDeltaY;
   NewForm.FOnReturnTime := OnReturnTime;
   NewForm.OnShow := OnShowHide;
   NewForm.OnHide := OnShowHide;
@@ -89,6 +107,7 @@
   Minute := MinuteOf(ATime);
   HoursGrid.Col := Hour mod 12;
   HoursGrid.Row := Hour div 12;
+  HoursGrid.TopRow := 0;  // Avoid morning hours scrolling out of view if time is > 12:00
   if FSimpleLayout then
   begin
     Minute := Minute - (Minute mod 5);
@@ -259,17 +278,21 @@
 var
   ABounds: TRect;
 begin
-  ABounds := Screen.MonitorFromPoint(PopupOrigin).BoundsRect;
+  ABounds := Screen.MonitorFromPoint(PopupOrigin).WorkAreaRect; // take care of taskbar
   if PopupOrigin.X + Width > ABounds.Right then
     Left := ABounds.Right - Width
   else
     Left := PopupOrigin.X;
   if PopupOrigin.Y + Height > ABounds.Bottom then
-    Top := ABounds.Bottom - Height
-  else
+  begin
+    if FAltPopupOriginDeltaY = MaxInt then
+      Top := ABounds.Bottom - Height
+    else
+      Top := PopupOrigin.Y + FAltPopupOriginDeltaY - Height
+      // Note: FAltPopupOrigin is negative if the popup form is called from a TTimeEdit
+      // i.e. the bottom of the popup is at the top of the edit
+  end else
     Top := PopupOrigin.Y;
-  //store the fitting point, so the form won't move if it layout is changed back to simple
-  FPopupOrigin := Point(Left, Top);
 end;
 
 procedure TTimePopupForm.ReturnTime;
TTimeEdit-v2.patch (4,569 bytes)

wp

2016-04-03 10:50

developer   ~0091688

Patch v2 comes with an overloaded version of ShowTimePopup to avoid (rare) breaking of existing code.

Bart Broersma

2016-04-03 11:13

developer   ~0091689

> Yes, but will really anybody call this alone without the TTimeEdit?
Probably not. I really should not write such comments at almost midnight ;-)

Wouldn't it make more sense to try to fix this in TTimePopupForm.KeepInView?
And then take the workarea and not the screen size into account?

I know it looks nice that the edit will always be in view, but also TDateEdit does not do that (it just moves the dialog up if it drops if the screen).

If it needs changing the signature of ShowTimePopup, maybe then make the new parameter the caller (in this case the TDateEdit instance), so we have all info on it's dimensions if and when needed (and if it's nil then only keep the dialog on the workarea).

wp

2016-04-03 14:44

developer  

TTimeEdit-v3.patch (8,265 bytes)
Index: lcl/editbtn.pas
===================================================================
--- lcl/editbtn.pas	(revision 52101)
+++ lcl/editbtn.pas	(working copy)
@@ -1597,7 +1597,7 @@
   if ADate = NullDate then
     ADate := SysUtils.Date;
   ShowCalendarPopup(PopupOrigin, ADate, CalendarDisplaySettings,
-                    @CalendarPopupReturnDate, @CalendarPopupShowHide);
+                    @CalendarPopupReturnDate, @CalendarPopupShowHide, self);
   //Do this after the dialog, otherwise it just looks silly
   if FocusOnButtonClick then FocusAndMaybeSelectAll;
 end;
@@ -2092,7 +2092,8 @@
   ATime := GetTime;
   if ATime = NullDate then
     ATime := SysUtils.Time;
-  ShowTimePopup(PopupOrigin, ATime, Self.DoubleBuffered, @TimePopupReturnTime, @TimePopupShowHide, FSimpleLayout);
+  ShowTimePopup(PopupOrigin, ATime, Self.DoubleBuffered, @TimePopupReturnTime,
+    @TimePopupShowHide, FSimpleLayout, self);
 end;
 
 function TTimeEdit.TryParseInput(AInput: String; out ParseResult: TDateTime): Boolean;
Index: lcl/forms/calendarpopup.lfm
===================================================================
--- lcl/forms/calendarpopup.lfm	(revision 52101)
+++ lcl/forms/calendarpopup.lfm	(working copy)
@@ -3,7 +3,6 @@
   Height = 192
   Top = 259
   Width = 233
-  AutoSize = True
   BorderIcons = [biMinimize, biMaximize]
   BorderStyle = bsNone
   Caption = 'CalendarPopupForm'
@@ -13,17 +12,18 @@
   OnCreate = FormCreate
   OnDeactivate = FormDeactivate
   PopupMode = pmAuto
-  LCLVersion = '0.9.31'
+  LCLVersion = '1.7'
   object Calendar: TCalendar
-    Left = 1
-    Height = 176
-    Top = 1
-    Width = 177
+    Left = 0
+    Height = 160
+    Top = 0
+    Width = 176
     AutoSize = True
     BorderSpacing.Around = 1
     DateTime = 38823
     OnDblClick = CalendarDblClick
     OnKeyDown = CalendarKeyDown
+    TabOrder = 0
     TabStop = True
   end
 end
Index: lcl/forms/calendarpopup.pas
===================================================================
--- lcl/forms/calendarpopup.pas	(revision 52101)
+++ lcl/forms/calendarpopup.pas	(working copy)
@@ -37,6 +37,7 @@
   private
     FClosed: boolean;
     FOnReturnDate: TReturnDateEvent;
+    FCaller: TControl;
     procedure Initialize(const PopupOrigin: TPoint; ADate: TDateTime;
                          const DisplaySettings: TDisplaySettings);
     procedure ReturnDate;
@@ -46,7 +47,8 @@
 
 procedure ShowCalendarPopup(const Position: TPoint; ADate: TDateTime;
     const CalendarDisplaySettings: TDisplaySettings;
-    const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil);
+    const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil;
+    ACaller: TControl = nil);
 
 implementation
 
@@ -54,11 +56,13 @@
 
 procedure ShowCalendarPopup(const Position: TPoint; ADate: TDateTime;
   const CalendarDisplaySettings: TDisplaySettings;
-  const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil);
+  const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent;
+  ACaller: TControl);
 var
   PopupForm: TCalendarPopupForm;
 begin
   PopupForm := TCalendarPopupForm.Create(nil);
+  PopupForm.FCaller := ACaller;
   PopupForm.Initialize(Position, ADate, CalendarDisplaySettings);
   PopupForm.FOnReturnDate := OnReturnDate;
   PopupForm.OnShow := OnShowHide;
@@ -71,6 +75,8 @@
 procedure TCalendarPopupForm.FormCreate(Sender: TObject);
 begin
   FClosed := false;
+  ClientWidth := Calendar.Width + 2*Calendar.Left;
+  ClientHeight := Calendar.Height + 2*Calendar.Top;
   Application.AddOnDeactivateHandler(@FormDeactivate);
 end;
 
@@ -131,16 +137,32 @@
   ADate: TDateTime; const DisplaySettings: TDisplaySettings);
 var
   ABounds: TRect;
+  P: TPoint;
 begin
-  ABounds := Screen.MonitorFromPoint(PopupOrigin).BoundsRect;
-  if PopupOrigin.X + Width > ABounds.Right then
+  if Assigned(FCaller) then
+    P := FCaller.ControlToScreen(Point(0, FCaller.Height))
+  else
+    P := PopupOrigin;
+
+  ABounds := Screen.MonitorFromPoint(P).WorkAreaRect;
+  if P.X + Width > ABounds.Right then
     Left := ABounds.Right - Width
+  else if P.X < ABounds.Left then
+    Left := ABounds.Left
   else
-    Left := PopupOrigin.X;
-  if PopupOrigin.Y + Height > ABounds.Bottom then
-    Top := ABounds.Bottom - Height
+    Left := P.X;
+
+  if P.Y + Height > ABounds.Bottom then
+  begin
+    if Assigned(FCaller) then
+      Top := P.Y - FCaller.Height - Height
+    else
+      Top := ABounds.Bottom - Height;
+  end else if P.Y < ABounds.Top then
+    Top := ABounds.Top
   else
     Top := PopupOrigin.Y;
+
   Calendar.DateTime := ADate;
   Calendar.DisplaySettings:=DisplaySettings;
 end;
Index: lcl/forms/timepopup.lfm
===================================================================
--- lcl/forms/timepopup.lfm	(revision 52101)
+++ lcl/forms/timepopup.lfm	(working copy)
@@ -13,7 +13,7 @@
   OnCreate = FormCreate
   OnDeactivate = FormDeactivate
   PopupMode = pmAuto
-  LCLVersion = '1.5'
+  LCLVersion = '1.7'
   object MainPanel: TPanel
     Left = 0
     Height = 185
Index: lcl/forms/timepopup.pas
===================================================================
--- lcl/forms/timepopup.pas	(revision 52101)
+++ lcl/forms/timepopup.pas	(working copy)
@@ -41,6 +41,7 @@
     FOnReturnTime: TReturnTimeEvent;
     FSimpleLayout: Boolean;
     FPopupOrigin: TPoint;
+    FCaller: TControl;
     procedure ActivateDoubleBuffered;
     procedure CalcGridHeights;
     function GetTime: TDateTime;
@@ -56,18 +57,22 @@
   end;
 
 procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean;
-                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent = nil; SimpleLayout: Boolean = True);
+                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent = nil;
+                        SimpleLayout: Boolean = True; ACaller: TControl = nil);
 
 implementation
 
 {$R *.lfm}
 
-procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean; const OnReturnTime: TReturnTimeEvent;
-                        const OnShowHide: TNotifyEvent; SimpleLayout: Boolean);
+procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean;
+                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent;
+                        SimpleLayout: Boolean; ACaller: TControl);
 var
   NewForm: TTimePopupForm;
+  P: TPoint;
 begin
   NewForm := TTimePopupForm.Create(nil);
+  NewForm.FCaller := ACaller;
   NewForm.Initialize(Position, ATime);
   NewForm.FOnReturnTime := OnReturnTime;
   NewForm.OnShow := OnShowHide;
@@ -78,7 +83,11 @@
   if not SimpleLayout then
     NewForm.SetTime(ATime); //update the row and col in the grid;
   NewForm.Show;
-  NewForm.KeepInView(Position);
+  if Assigned(ACaller) then
+    P := ACaller.ControlToScreen(Point(0, ACaller.Height))
+  else
+    P := Position;
+  NewForm.KeepInView(P);
 end;
 
 procedure TTimePopupForm.SetTime(ATime: TDateTime);
@@ -89,6 +98,7 @@
   Minute := MinuteOf(ATime);
   HoursGrid.Col := Hour mod 12;
   HoursGrid.Row := Hour div 12;
+  HoursGrid.TopRow := 0;  // Avoid morning hours scrolling out of view if time is > 12:00
   if FSimpleLayout then
   begin
     Minute := Minute - (Minute mod 5);
@@ -259,17 +269,25 @@
 var
   ABounds: TRect;
 begin
-  ABounds := Screen.MonitorFromPoint(PopupOrigin).BoundsRect;
+  ABounds := Screen.MonitorFromPoint(PopupOrigin).WorkAreaRect; // take care of taskbar
+
   if PopupOrigin.X + Width > ABounds.Right then
     Left := ABounds.Right - Width
+  else if PopupOrigin.X < ABounds.Left then
+    Left := ABounds.Left
   else
     Left := PopupOrigin.X;
+
   if PopupOrigin.Y + Height > ABounds.Bottom then
-    Top := ABounds.Bottom - Height
+  begin
+    if Assigned(FCaller) then
+      Top := PopupOrigin.Y - FCaller.Height - Height
+    else
+      Top := ABounds.Bottom - Height;
+  end else if PopupOrigin.Y < ABounds.Top then
+    Top := ABounds.Top
   else
     Top := PopupOrigin.Y;
-  //store the fitting point, so the form won't move if it layout is changed back to simple
-  FPopupOrigin := Point(Left, Top);
 end;
 
 procedure TTimePopupForm.ReturnTime;
TTimeEdit-v3.patch (8,265 bytes)

wp

2016-04-03 14:56

developer   ~0091695

Another round, v3: This patch picks up your idea with the caller, it has the advantage that there is not need to override the ShowTimePopup due to using it as an optional parameters at a reasonable position in the parameter list. I extended the idea such that if the caller is assigned the popup position is completely recalculated making the procedure a bit more self-contained, i.e. if caller is nil there is the old behavior, if it is assigned the positioning is entirely controlled by the caller.

The monitor workarea has been considered already in the first patch, but I went a step further checking also the left and top edges of the work area. Now it is guaranteed that the popup always stays within the workarea.

Since the TDateEdit suffers from the same issue I included the patch for this component as well. There is the additional complication that the calendar form is auto-sized, but AutoSize is evaluated only after showing the form when it is already positioned, therefore the calendar does not touch the right screen (workarea) border if the edit is too close at it. I fixed it by manually sizing to form to the calendar size in FormCreate.

In the TDateEdit, the left and top margins of the calendar had been set to 1. I don't know why this was selected, it gives the popdown a strange kind of 3D-border look (on Windows). After setting them to 0, the popup looks better, in my opinion, but feel free to reset them to 1.

wp

2016-04-04 23:12

developer  

TDateTimeEdit-v4.patch (8,207 bytes)
Index: lcl/editbtn.pas
===================================================================
--- lcl/editbtn.pas	(revision 52101)
+++ lcl/editbtn.pas	(working copy)
@@ -1597,7 +1597,7 @@
   if ADate = NullDate then
     ADate := SysUtils.Date;
   ShowCalendarPopup(PopupOrigin, ADate, CalendarDisplaySettings,
-                    @CalendarPopupReturnDate, @CalendarPopupShowHide);
+                    @CalendarPopupReturnDate, @CalendarPopupShowHide, self);
   //Do this after the dialog, otherwise it just looks silly
   if FocusOnButtonClick then FocusAndMaybeSelectAll;
 end;
@@ -2092,7 +2092,8 @@
   ATime := GetTime;
   if ATime = NullDate then
     ATime := SysUtils.Time;
-  ShowTimePopup(PopupOrigin, ATime, Self.DoubleBuffered, @TimePopupReturnTime, @TimePopupShowHide, FSimpleLayout);
+  ShowTimePopup(PopupOrigin, ATime, Self.DoubleBuffered, @TimePopupReturnTime,
+    @TimePopupShowHide, FSimpleLayout, self);
 end;
 
 function TTimeEdit.TryParseInput(AInput: String; out ParseResult: TDateTime): Boolean;
Index: lcl/forms/calendarpopup.lfm
===================================================================
--- lcl/forms/calendarpopup.lfm	(revision 52101)
+++ lcl/forms/calendarpopup.lfm	(working copy)
@@ -13,17 +13,17 @@
   OnCreate = FormCreate
   OnDeactivate = FormDeactivate
   PopupMode = pmAuto
-  LCLVersion = '0.9.31'
+  LCLVersion = '1.7'
   object Calendar: TCalendar
-    Left = 1
-    Height = 176
-    Top = 1
-    Width = 177
-    AutoSize = True
+    Left = 0
+    Height = 160
+    Top = 0
+    Width = 176
     BorderSpacing.Around = 1
     DateTime = 38823
     OnDblClick = CalendarDblClick
     OnKeyDown = CalendarKeyDown
+    TabOrder = 0
     TabStop = True
   end
 end
Index: lcl/forms/calendarpopup.pas
===================================================================
--- lcl/forms/calendarpopup.pas	(revision 52101)
+++ lcl/forms/calendarpopup.pas	(working copy)
@@ -37,6 +37,7 @@
   private
     FClosed: boolean;
     FOnReturnDate: TReturnDateEvent;
+    FCaller: TControl;
     procedure Initialize(const PopupOrigin: TPoint; ADate: TDateTime;
                          const DisplaySettings: TDisplaySettings);
     procedure ReturnDate;
@@ -46,7 +47,8 @@
 
 procedure ShowCalendarPopup(const Position: TPoint; ADate: TDateTime;
     const CalendarDisplaySettings: TDisplaySettings;
-    const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil);
+    const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil;
+    ACaller: TControl = nil);
 
 implementation
 
@@ -54,11 +56,13 @@
 
 procedure ShowCalendarPopup(const Position: TPoint; ADate: TDateTime;
   const CalendarDisplaySettings: TDisplaySettings;
-  const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil);
+  const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent;
+  ACaller: TControl);
 var
   PopupForm: TCalendarPopupForm;
 begin
   PopupForm := TCalendarPopupForm.Create(nil);
+  PopupForm.FCaller := ACaller;
   PopupForm.Initialize(Position, ADate, CalendarDisplaySettings);
   PopupForm.FOnReturnDate := OnReturnDate;
   PopupForm.OnShow := OnShowHide;
@@ -71,6 +75,8 @@
 procedure TCalendarPopupForm.FormCreate(Sender: TObject);
 begin
   FClosed := false;
+  ClientWidth := Calendar.Width + 2*Calendar.Left;
+  ClientHeight := Calendar.Height + 2*Calendar.Top;
   Application.AddOnDeactivateHandler(@FormDeactivate);
 end;
 
@@ -131,18 +137,34 @@
   ADate: TDateTime; const DisplaySettings: TDisplaySettings);
 var
   ABounds: TRect;
+  P: TPoint;
 begin
-  ABounds := Screen.MonitorFromPoint(PopupOrigin).BoundsRect;
-  if PopupOrigin.X + Width > ABounds.Right then
+  Calendar.DateTime := ADate;
+  Calendar.DisplaySettings:=DisplaySettings;
+
+  if Assigned(FCaller) then
+    P := FCaller.ControlToScreen(Point(0, FCaller.Height))
+  else
+    P := PopupOrigin;
+
+  ABounds := Screen.MonitorFromPoint(P).WorkAreaRect;
+  if P.X + Width > ABounds.Right then
     Left := ABounds.Right - Width
+  else if P.X < ABounds.Left then
+    Left := ABounds.Left
   else
-    Left := PopupOrigin.X;
-  if PopupOrigin.Y + Height > ABounds.Bottom then
-    Top := ABounds.Bottom - Height
+    Left := P.X;
+
+  if P.Y + Height > ABounds.Bottom then
+  begin
+    if Assigned(FCaller) then
+      Top := P.Y - FCaller.Height - Height
+    else
+      Top := ABounds.Bottom - Height;
+  end else if P.Y < ABounds.Top then
+    Top := ABounds.Top
   else
     Top := PopupOrigin.Y;
-  Calendar.DateTime := ADate;
-  Calendar.DisplaySettings:=DisplaySettings;
 end;
 
 procedure TCalendarPopupForm.ReturnDate;
Index: lcl/forms/timepopup.lfm
===================================================================
--- lcl/forms/timepopup.lfm	(revision 52101)
+++ lcl/forms/timepopup.lfm	(working copy)
@@ -13,7 +13,7 @@
   OnCreate = FormCreate
   OnDeactivate = FormDeactivate
   PopupMode = pmAuto
-  LCLVersion = '1.5'
+  LCLVersion = '1.7'
   object MainPanel: TPanel
     Left = 0
     Height = 185
Index: lcl/forms/timepopup.pas
===================================================================
--- lcl/forms/timepopup.pas	(revision 52101)
+++ lcl/forms/timepopup.pas	(working copy)
@@ -41,6 +41,7 @@
     FOnReturnTime: TReturnTimeEvent;
     FSimpleLayout: Boolean;
     FPopupOrigin: TPoint;
+    FCaller: TControl;
     procedure ActivateDoubleBuffered;
     procedure CalcGridHeights;
     function GetTime: TDateTime;
@@ -56,18 +57,22 @@
   end;
 
 procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean;
-                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent = nil; SimpleLayout: Boolean = True);
+                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent = nil;
+                        SimpleLayout: Boolean = True; ACaller: TControl = nil);
 
 implementation
 
 {$R *.lfm}
 
-procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean; const OnReturnTime: TReturnTimeEvent;
-                        const OnShowHide: TNotifyEvent; SimpleLayout: Boolean);
+procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean;
+                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent;
+                        SimpleLayout: Boolean; ACaller: TControl);
 var
   NewForm: TTimePopupForm;
+  P: TPoint;
 begin
   NewForm := TTimePopupForm.Create(nil);
+  NewForm.FCaller := ACaller;
   NewForm.Initialize(Position, ATime);
   NewForm.FOnReturnTime := OnReturnTime;
   NewForm.OnShow := OnShowHide;
@@ -78,7 +83,11 @@
   if not SimpleLayout then
     NewForm.SetTime(ATime); //update the row and col in the grid;
   NewForm.Show;
-  NewForm.KeepInView(Position);
+  if Assigned(ACaller) then
+    P := ACaller.ControlToScreen(Point(0, ACaller.Height))
+  else
+    P := Position;
+  NewForm.KeepInView(P);
 end;
 
 procedure TTimePopupForm.SetTime(ATime: TDateTime);
@@ -89,6 +98,7 @@
   Minute := MinuteOf(ATime);
   HoursGrid.Col := Hour mod 12;
   HoursGrid.Row := Hour div 12;
+  HoursGrid.TopRow := 0;  // Avoid morning hours scrolling out of view if time is > 12:00
   if FSimpleLayout then
   begin
     Minute := Minute - (Minute mod 5);
@@ -259,17 +269,25 @@
 var
   ABounds: TRect;
 begin
-  ABounds := Screen.MonitorFromPoint(PopupOrigin).BoundsRect;
+  ABounds := Screen.MonitorFromPoint(PopupOrigin).WorkAreaRect; // take care of taskbar
+
   if PopupOrigin.X + Width > ABounds.Right then
     Left := ABounds.Right - Width
+  else if PopupOrigin.X < ABounds.Left then
+    Left := ABounds.Left
   else
     Left := PopupOrigin.X;
+
   if PopupOrigin.Y + Height > ABounds.Bottom then
-    Top := ABounds.Bottom - Height
+  begin
+    if Assigned(FCaller) then
+      Top := PopupOrigin.Y - FCaller.Height - Height
+    else
+      Top := ABounds.Bottom - Height;
+  end else if PopupOrigin.Y < ABounds.Top then
+    Top := ABounds.Top
   else
     Top := PopupOrigin.Y;
-  //store the fitting point, so the form won't move if it layout is changed back to simple
-  FPopupOrigin := Point(Left, Top);
 end;
 
 procedure TTimePopupForm.ReturnTime;
TDateTimeEdit-v4.patch (8,207 bytes)

wp

2016-04-04 23:13

developer   ~0091743

Grrrh... I see now that the CalendarPopup is not sized correctly if the test project has themes turned off (in Win). Turning AutoSize back on results in the correct size for both themed and non-themed settings. --> new patch v4

Bart Broersma

2016-04-05 14:49

developer   ~0091757

@wp: could you separate the patches for calendar en time please?

wp

2016-04-05 15:09

developer  

TTimeEdit-v5.patch (4,205 bytes)
Index: lcl/editbtn.pas
===================================================================
--- lcl/editbtn.pas	(revision 52105)
+++ lcl/editbtn.pas	(working copy)
@@ -2092,7 +2092,8 @@
   ATime := GetTime;
   if ATime = NullDate then
     ATime := SysUtils.Time;
-  ShowTimePopup(PopupOrigin, ATime, Self.DoubleBuffered, @TimePopupReturnTime, @TimePopupShowHide, FSimpleLayout);
+  ShowTimePopup(PopupOrigin, ATime, Self.DoubleBuffered,
+    @TimePopupReturnTime, @TimePopupShowHide, FSimpleLayout, self);
 end;
 
 function TTimeEdit.TryParseInput(AInput: String; out ParseResult: TDateTime): Boolean;
Index: lcl/forms/timepopup.lfm
===================================================================
--- lcl/forms/timepopup.lfm	(revision 52105)
+++ lcl/forms/timepopup.lfm	(working copy)
@@ -13,7 +13,7 @@
   OnCreate = FormCreate
   OnDeactivate = FormDeactivate
   PopupMode = pmAuto
-  LCLVersion = '1.5'
+  LCLVersion = '1.7'
   object MainPanel: TPanel
     Left = 0
     Height = 185
Index: lcl/forms/timepopup.pas
===================================================================
--- lcl/forms/timepopup.pas	(revision 52105)
+++ lcl/forms/timepopup.pas	(working copy)
@@ -41,6 +41,7 @@
     FOnReturnTime: TReturnTimeEvent;
     FSimpleLayout: Boolean;
     FPopupOrigin: TPoint;
+    FCaller: TControl;
     procedure ActivateDoubleBuffered;
     procedure CalcGridHeights;
     function GetTime: TDateTime;
@@ -56,18 +57,22 @@
   end;
 
 procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean;
-                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent = nil; SimpleLayout: Boolean = True);
+                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent = nil;
+                        SimpleLayout: Boolean = True; ACaller: TControl = nil);
 
 implementation
 
 {$R *.lfm}
 
-procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean; const OnReturnTime: TReturnTimeEvent;
-                        const OnShowHide: TNotifyEvent; SimpleLayout: Boolean);
+procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean;
+                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent;
+                        SimpleLayout: Boolean; ACaller: TControl);
 var
   NewForm: TTimePopupForm;
+  P: TPoint;
 begin
   NewForm := TTimePopupForm.Create(nil);
+  NewForm.FCaller := ACaller;
   NewForm.Initialize(Position, ATime);
   NewForm.FOnReturnTime := OnReturnTime;
   NewForm.OnShow := OnShowHide;
@@ -78,7 +83,11 @@
   if not SimpleLayout then
     NewForm.SetTime(ATime); //update the row and col in the grid;
   NewForm.Show;
-  NewForm.KeepInView(Position);
+  if Assigned(ACaller) then
+    P := ACaller.ControlToScreen(Point(0, ACaller.Height))
+  else
+    P := Position;
+  NewForm.KeepInView(P);
 end;
 
 procedure TTimePopupForm.SetTime(ATime: TDateTime);
@@ -89,6 +98,7 @@
   Minute := MinuteOf(ATime);
   HoursGrid.Col := Hour mod 12;
   HoursGrid.Row := Hour div 12;
+  HoursGrid.TopRow := 0;  // Avoid morning hours scrolling out of view if time is > 12:00
   if FSimpleLayout then
   begin
     Minute := Minute - (Minute mod 5);
@@ -259,17 +269,25 @@
 var
   ABounds: TRect;
 begin
-  ABounds := Screen.MonitorFromPoint(PopupOrigin).BoundsRect;
+  ABounds := Screen.MonitorFromPoint(PopupOrigin).WorkAreaRect; // take care of taskbar
+
   if PopupOrigin.X + Width > ABounds.Right then
     Left := ABounds.Right - Width
+  else if PopupOrigin.X < ABounds.Left then
+    Left := ABounds.Left
   else
     Left := PopupOrigin.X;
+
   if PopupOrigin.Y + Height > ABounds.Bottom then
-    Top := ABounds.Bottom - Height
+  begin
+    if Assigned(FCaller) then
+      Top := PopupOrigin.Y - FCaller.Height - Height
+    else
+      Top := ABounds.Bottom - Height;
+  end else if PopupOrigin.Y < ABounds.Top then
+    Top := ABounds.Top
   else
     Top := PopupOrigin.Y;
-  //store the fitting point, so the form won't move if it layout is changed back to simple
-  FPopupOrigin := Point(Left, Top);
 end;
 
 procedure TTimePopupForm.ReturnTime;
TTimeEdit-v5.patch (4,205 bytes)

wp

2016-04-05 15:14

developer   ~0091762

Last edited: 2016-04-05 15:24

View 3 revisions

v5 is the TTimeEdit-only patch, the TDateEdit part will follow once the TTimeEdit part is online (I don't know how to create a patch against my own local repository) - or do you want me to write a separate report for TDateEdit?

Since this report covers two issues ( (1): positioning issue at screen edge, (2): hours scrolling out of view) here's how to separate them in the patch:
(2) is fixed by the line "HoursGrid.TopRow := 0" of TimePopup.pas. All the other changes cover issue (1).

Bart Broersma

2016-04-05 17:00

developer  

timedit-offscreen.png (82,153 bytes)
timedit-offscreen.png (82,153 bytes)

Bart Broersma

2016-04-05 17:25

developer   ~0091767

Applied TTimeEdit-v5.patch with minor modification because in certain cases the popup-form could now be placed too far up (see: timedit-offscreen.png).
Added some comments too.
Thans for the patch.

Now the patch for TDateEdit and we can close this ;-)

wp

2016-04-05 20:44

developer  

TDateEdit-v6.patch (5,415 bytes)
Index: lcl/editbtn.pas
===================================================================
--- lcl/editbtn.pas	(revision 52106)
+++ lcl/editbtn.pas	(working copy)
@@ -1597,7 +1597,7 @@
   if ADate = NullDate then
     ADate := SysUtils.Date;
   ShowCalendarPopup(PopupOrigin, ADate, CalendarDisplaySettings,
-                    @CalendarPopupReturnDate, @CalendarPopupShowHide);
+                    @CalendarPopupReturnDate, @CalendarPopupShowHide, self);
   //Do this after the dialog, otherwise it just looks silly
   if FocusOnButtonClick then FocusAndMaybeSelectAll;
 end;
Index: lcl/forms/calendarpopup.lfm
===================================================================
--- lcl/forms/calendarpopup.lfm	(revision 52106)
+++ lcl/forms/calendarpopup.lfm	(working copy)
@@ -13,17 +13,17 @@
   OnCreate = FormCreate
   OnDeactivate = FormDeactivate
   PopupMode = pmAuto
-  LCLVersion = '0.9.31'
+  LCLVersion = '1.7'
   object Calendar: TCalendar
-    Left = 1
-    Height = 176
-    Top = 1
-    Width = 177
+    Left = 0
+    Height = 160
+    Top = 0
+    Width = 176
     AutoSize = True
-    BorderSpacing.Around = 1
     DateTime = 38823
     OnDblClick = CalendarDblClick
     OnKeyDown = CalendarKeyDown
+    TabOrder = 0
     TabStop = True
   end
 end
Index: lcl/forms/calendarpopup.pas
===================================================================
--- lcl/forms/calendarpopup.pas	(revision 52106)
+++ lcl/forms/calendarpopup.pas	(working copy)
@@ -20,7 +20,8 @@
 interface
 
 uses
-  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Calendar, LCLProc, LCLType;
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Calendar, LCLProc,
+  LCLType;
   
 type
   TReturnDateEvent = procedure (Sender: TObject; const Date: TDateTime) of object;
@@ -37,33 +38,42 @@
   private
     FClosed: boolean;
     FOnReturnDate: TReturnDateEvent;
+    FCaller: TControl;
+    FPopupOrigin: TPoint;
     procedure Initialize(const PopupOrigin: TPoint; ADate: TDateTime;
                          const DisplaySettings: TDisplaySettings);
+    procedure KeepInView;
     procedure ReturnDate;
-  protected
-    procedure Paint; override;
   end;
 
 procedure ShowCalendarPopup(const Position: TPoint; ADate: TDateTime;
     const CalendarDisplaySettings: TDisplaySettings;
-    const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil);
+    const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil;
+    ACaller: TControl = nil);
 
 implementation
 
+{$IFDEF WINDOWS}
+uses Themes;
+{$ENDIF}
+
 {$R *.lfm}
 
 procedure ShowCalendarPopup(const Position: TPoint; ADate: TDateTime;
   const CalendarDisplaySettings: TDisplaySettings;
-  const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil);
+  const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent;
+  ACaller: TControl);
 var
   PopupForm: TCalendarPopupForm;
 begin
   PopupForm := TCalendarPopupForm.Create(nil);
+  PopupForm.FCaller := ACaller;
   PopupForm.Initialize(Position, ADate, CalendarDisplaySettings);
   PopupForm.FOnReturnDate := OnReturnDate;
   PopupForm.OnShow := OnShowHide;
   PopupForm.OnHide := OnShowHide;
   PopupForm.Show;
+  PopupForm.KeepInView;
 end;
 
 { TCalendarPopupForm }
@@ -72,6 +82,14 @@
 begin
   FClosed := false;
   Application.AddOnDeactivateHandler(@FormDeactivate);
+  { Make sure that there is a border around the popup calendar in unthemed
+    Windows because the calendar is borderless in this case. }
+  {$IFDEF WINDOWS}
+  if not ThemeServices.ThemesEnabled then begin
+    Color := clWindowFrame;
+    Calendar.BorderSpacing.Around := 1;
+  end;
+  {$ENDIF}
 end;
 
 procedure TCalendarPopupForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
@@ -129,20 +147,36 @@
 
 procedure TCalendarPopupForm.Initialize(const PopupOrigin: TPoint;
   ADate: TDateTime; const DisplaySettings: TDisplaySettings);
+begin
+  Calendar.DateTime := ADate;
+  Calendar.DisplaySettings:=DisplaySettings;
+  FPopupOrigin := PopupOrigin;
+end;
+
+procedure TCalendarPopupForm.KeepInView;
 var
   ABounds: TRect;
+  P: TPoint;
 begin
-  ABounds := Screen.MonitorFromPoint(PopupOrigin).BoundsRect;
-  if PopupOrigin.X + Width > ABounds.Right then
+  ABounds := Screen.MonitorFromPoint(FPopupOrigin).WorkAreaRect; // take care of taskbar
+  if FPopupOrigin.X + Width > ABounds.Right then
     Left := ABounds.Right - Width
+  else if FPopupOrigin.X < ABounds.Left then
+    Left := ABounds.Left
   else
-    Left := PopupOrigin.X;
-  if PopupOrigin.Y + Height > ABounds.Bottom then
-    Top := ABounds.Bottom - Height
+    Left := FPopupOrigin.X;
+  if FPopupOrigin.Y + Height > ABounds.Bottom then
+  begin
+    if Assigned(FCaller) then
+      Top := FPopupOrigin.Y - FCaller.Height - Height
+    else
+      Top := ABounds.Bottom - Height;
+  end else if FPopupOrigin.Y < ABounds.Top then
+    Top := ABounds.Top
   else
-    Top := PopupOrigin.Y;
-  Calendar.DateTime := ADate;
-  Calendar.DisplaySettings:=DisplaySettings;
+    Top := FPopupOrigin.Y;
+  if Left < ABounds.Left then Left := 0;
+  if Top < ABounds.Top then Top := 0;
 end;
 
 procedure TCalendarPopupForm.ReturnDate;
@@ -153,12 +187,4 @@
     Close;
 end;
 
-procedure TCalendarPopupForm.Paint;
-begin
-  inherited Paint;
-  Canvas.Pen.Color := clWindowText;
-  Canvas.Pen.Style := psSolid;
-  Canvas.Rectangle(0, 0, Width-1, Height-1);
-end;
-
 end.
TDateEdit-v6.patch (5,415 bytes)

wp

2016-04-05 20:51

developer   ~0091769

Here is the TDateEdit patch (v6). I modified the sources again because the calendar of non-themed Windows is borderless, while themed windows and qt and gtk2 do have a border, and sometimes the borders of the dropdown don't look good. Therefore, I decided to add an IFDEF WINDOWS to cover this case - maybe you don't like this... Anyway, I tested with Win, qt and gtk2, and the popup look ok now.

I saw another issue: the non-themed Windows dropdown does not react upon a double-click. This is because the calendar hittest fails. Seems to be stuff for a different report, though.

Bart Broersma

2016-04-06 11:36

developer   ~0091779

Th changes you made w.r.g. how the popup is now painted really look odd on linux QT: there the calendar popup does not have a distinct border anymore.

Can you split this patch also in
1) a patch that does the "keep the form in the right place"
2) a patch for the looks of the popup

About:
> the non-themed Windows dropdown does not react upon a double-click.
Yes please open a new ticket about that. Feel free to assign it to me.

Bart Broersma

2016-04-06 12:52

developer   ~0091785

> Yes please open a new ticket about that.
Done: 0029975

wp

2016-04-06 15:43

developer  

TDateEdit-v7.patch (4,592 bytes)
Index: lcl/editbtn.pas
===================================================================
--- lcl/editbtn.pas	(revision 52114)
+++ lcl/editbtn.pas	(working copy)
@@ -1597,7 +1597,7 @@
   if ADate = NullDate then
     ADate := SysUtils.Date;
   ShowCalendarPopup(PopupOrigin, ADate, CalendarDisplaySettings,
-                    @CalendarPopupReturnDate, @CalendarPopupShowHide);
+                    @CalendarPopupReturnDate, @CalendarPopupShowHide, self);
   //Do this after the dialog, otherwise it just looks silly
   if FocusOnButtonClick then FocusAndMaybeSelectAll;
 end;
Index: lcl/forms/calendarpopup.lfm
===================================================================
--- lcl/forms/calendarpopup.lfm	(revision 52114)
+++ lcl/forms/calendarpopup.lfm	(working copy)
@@ -13,17 +13,18 @@
   OnCreate = FormCreate
   OnDeactivate = FormDeactivate
   PopupMode = pmAuto
-  LCLVersion = '0.9.31'
+  LCLVersion = '1.7'
   object Calendar: TCalendar
     Left = 1
-    Height = 176
+    Height = 160
     Top = 1
-    Width = 177
+    Width = 176
     AutoSize = True
     BorderSpacing.Around = 1
     DateTime = 38823
     OnDblClick = CalendarDblClick
     OnKeyDown = CalendarKeyDown
+    TabOrder = 0
     TabStop = True
   end
 end
Index: lcl/forms/calendarpopup.pas
===================================================================
--- lcl/forms/calendarpopup.pas	(revision 52114)
+++ lcl/forms/calendarpopup.pas	(working copy)
@@ -35,10 +35,12 @@
     procedure FormCreate(Sender: TObject);
     procedure FormDeactivate(Sender: TObject);
   private
+    FCaller: TControl;
     FClosed: boolean;
     FOnReturnDate: TReturnDateEvent;
-    procedure Initialize(const PopupOrigin: TPoint; ADate: TDateTime;
-                         const DisplaySettings: TDisplaySettings);
+    procedure Initialize(ADate: TDateTime;
+      const DisplaySettings: TDisplaySettings);
+    procedure KeepInView(const PopupOrigin: TPoint);
     procedure ReturnDate;
   protected
     procedure Paint; override;
@@ -46,7 +48,8 @@
 
 procedure ShowCalendarPopup(const Position: TPoint; ADate: TDateTime;
     const CalendarDisplaySettings: TDisplaySettings;
-    const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil);
+    const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil;
+    ACaller: TControl = nil);
 
 implementation
 
@@ -54,16 +57,19 @@
 
 procedure ShowCalendarPopup(const Position: TPoint; ADate: TDateTime;
   const CalendarDisplaySettings: TDisplaySettings;
-  const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent = nil);
+  const OnReturnDate: TReturnDateEvent; const OnShowHide: TNotifyEvent;
+  ACaller: TControl);
 var
   PopupForm: TCalendarPopupForm;
 begin
   PopupForm := TCalendarPopupForm.Create(nil);
-  PopupForm.Initialize(Position, ADate, CalendarDisplaySettings);
+  PopupForm.FCaller := ACaller;
+  PopupForm.Initialize(ADate, CalendarDisplaySettings);
   PopupForm.FOnReturnDate := OnReturnDate;
   PopupForm.OnShow := OnShowHide;
   PopupForm.OnHide := OnShowHide;
   PopupForm.Show;
+  PopupForm.KeepInView(Position);   // must be after Show for PopupForm.AutoSize to be in effect.
 end;
 
 { TCalendarPopupForm }
@@ -127,22 +133,37 @@
     Close;
 end;
 
-procedure TCalendarPopupForm.Initialize(const PopupOrigin: TPoint;
-  ADate: TDateTime; const DisplaySettings: TDisplaySettings);
+procedure TCalendarPopupForm.Initialize(ADate: TDateTime;
+  const DisplaySettings: TDisplaySettings);
+begin
+  Calendar.DateTime := ADate;
+  Calendar.DisplaySettings:=DisplaySettings;
+end;
+
+procedure TCalendarPopupForm.KeepInView(const PopupOrigin: TPoint);
 var
   ABounds: TRect;
+  P: TPoint;
 begin
-  ABounds := Screen.MonitorFromPoint(PopupOrigin).BoundsRect;
+  ABounds := Screen.MonitorFromPoint(PopupOrigin).WorkAreaRect; // take care of taskbar
   if PopupOrigin.X + Width > ABounds.Right then
     Left := ABounds.Right - Width
+  else if PopupOrigin.X < ABounds.Left then
+    Left := ABounds.Left
   else
     Left := PopupOrigin.X;
   if PopupOrigin.Y + Height > ABounds.Bottom then
-    Top := ABounds.Bottom - Height
+  begin
+    if Assigned(FCaller) then
+      Top := PopupOrigin.Y - FCaller.Height - Height
+    else
+      Top := ABounds.Bottom - Height;
+  end else if PopupOrigin.Y < ABounds.Top then
+    Top := ABounds.Top
   else
     Top := PopupOrigin.Y;
-  Calendar.DateTime := ADate;
-  Calendar.DisplaySettings:=DisplaySettings;
+  if Left < ABounds.Left then Left := 0;
+  if Top < ABounds.Top then Top := 0;
 end;
 
 procedure TCalendarPopupForm.ReturnDate;
TDateEdit-v7.patch (4,592 bytes)

wp

2016-04-06 15:46

developer   ~0091793

Patch v7 fixes the TDateEdit popup positioning issue. Tested on Win7 themed/unthemed, gtk2, qt.

Thanks for the dblclick report.

Bart Broersma

2016-04-06 19:26

developer   ~0091798

Applied last patch.
As always: thanks.

wp

2016-04-06 21:57

developer  

TDateEdit-v8.patch (892 bytes)
Index: lcl/forms/calendarpopup.lfm
===================================================================
--- lcl/forms/calendarpopup.lfm	(revision 52118)
+++ lcl/forms/calendarpopup.lfm	(working copy)
@@ -15,10 +15,10 @@
   PopupMode = pmAuto
   LCLVersion = '1.7'
   object Calendar: TCalendar
-    Left = 1
+    Left = 0
     Height = 160
-    Top = 1
-    Width = 169
+    Top = 0
+    Width = 176
     AutoSize = True
     BorderSpacing.Around = 1
     DateTime = 38823
Index: lcl/forms/calendarpopup.pas
===================================================================
--- lcl/forms/calendarpopup.pas	(revision 52118)
+++ lcl/forms/calendarpopup.pas	(working copy)
@@ -179,7 +179,7 @@
   inherited Paint;
   Canvas.Pen.Color := clWindowText;
   Canvas.Pen.Style := psSolid;
-  Canvas.Rectangle(0, 0, Width-1, Height-1);
+  Canvas.Rectangle(0, 0, Width, Height);
 end;
 
 end.
TDateEdit-v8.patch (892 bytes)

wp

2016-04-06 22:03

developer   ~0091802

The border painting issue is still open. But I gave up to find a "universal" solution, it's not worth the effort. Just one simple patch (v8) which is probably not useless: In unthemed windows and qt the right and bottom border lines are missing because the rectangle in the Paint method goes only to Width-1 and Height-1. Removing the -1 fixes this. This leaves the too-broad themed Windows border, and the strange double border of gtk2 (plus probably many issues with other widgetsets); they would be fixed by removing the BorderSpacing.Around, but this kills the border of the others. I said: that's not worth the effort...

Bart Broersma

2016-04-06 23:16

developer   ~0091803

Sorry, missed that.

Bart Broersma

2016-04-07 15:13

developer   ~0091820

Please test and close if OK.

wp

2016-04-11 20:55

developer   ~0091952

Why v1.8? Aren't these bugs which we removed here?

Bart Broersma

2016-04-11 23:30

developer   ~0091954

Because I have made some very radical changes to the TEditButton class, which makes merging almost impossible.

wp

2016-04-11 23:43

developer   ~0091956

ok

Issue History

Date Modified Username Field Change
2016-04-02 23:02 wp New Issue
2016-04-02 23:02 wp File Added: TTimeEdit.patch
2016-04-02 23:04 wp File Added: TTimeEdit-before.png
2016-04-02 23:04 wp File Added: TTimeEdit-after.png
2016-04-02 23:05 wp File Added: TimeEdit-BugReport-29949.zip
2016-04-02 23:07 wp Steps to Reproduce Updated View Revisions
2016-04-02 23:12 wp File Deleted: TTimeEdit-before.png
2016-04-02 23:12 wp File Deleted: TTimeEdit-after.png
2016-04-02 23:12 wp File Added: TTimeEdit-before.png
2016-04-02 23:13 wp File Added: TTimeEdit-after.png
2016-04-02 23:56 Bart Broersma Assigned To => Bart Broersma
2016-04-02 23:56 Bart Broersma Status new => assigned
2016-04-02 23:58 Bart Broersma Note Added: 0091685
2016-04-02 23:58 Bart Broersma Status assigned => feedback
2016-04-03 01:12 wp Note Added: 0091686
2016-04-03 01:12 wp Status feedback => assigned
2016-04-03 04:15 wp Note Edited: 0091686 View Revisions
2016-04-03 10:49 wp File Added: TTimeEdit-v2.patch
2016-04-03 10:50 wp Note Added: 0091688
2016-04-03 11:13 Bart Broersma Note Added: 0091689
2016-04-03 14:44 wp File Added: TTimeEdit-v3.patch
2016-04-03 14:56 wp Note Added: 0091695
2016-04-04 23:12 wp File Added: TDateTimeEdit-v4.patch
2016-04-04 23:13 wp Note Added: 0091743
2016-04-05 14:49 Bart Broersma Note Added: 0091757
2016-04-05 15:09 wp File Added: TTimeEdit-v5.patch
2016-04-05 15:14 wp Note Added: 0091762
2016-04-05 15:15 wp Note Edited: 0091762 View Revisions
2016-04-05 15:24 wp Note Edited: 0091762 View Revisions
2016-04-05 17:00 Bart Broersma File Added: timedit-offscreen.png
2016-04-05 17:22 Bart Broersma Fixed in Revision => r52106
2016-04-05 17:25 Bart Broersma Note Added: 0091767
2016-04-05 20:44 wp File Added: TDateEdit-v6.patch
2016-04-05 20:51 wp Note Added: 0091769
2016-04-06 11:36 Bart Broersma Note Added: 0091779
2016-04-06 12:52 Bart Broersma Note Added: 0091785
2016-04-06 15:43 wp File Added: TDateEdit-v7.patch
2016-04-06 15:46 wp Note Added: 0091793
2016-04-06 19:26 Bart Broersma Fixed in Revision r52106 => r52106, r52118
2016-04-06 19:26 Bart Broersma LazTarget - => 1.8
2016-04-06 19:26 Bart Broersma Note Added: 0091798
2016-04-06 19:26 Bart Broersma Status assigned => resolved
2016-04-06 19:26 Bart Broersma Fixed in Version => 1.8
2016-04-06 19:26 Bart Broersma Resolution open => fixed
2016-04-06 19:26 Bart Broersma Target Version => 1.8
2016-04-06 21:57 wp File Added: TDateEdit-v8.patch
2016-04-06 22:03 wp Note Added: 0091802
2016-04-06 22:03 wp Status resolved => feedback
2016-04-06 23:16 Bart Broersma Note Added: 0091803
2016-04-06 23:16 Bart Broersma Status feedback => assigned
2016-04-07 15:13 Bart Broersma Fixed in Revision r52106, r52118 => r52106, r52118, r52144
2016-04-07 15:13 Bart Broersma Note Added: 0091820
2016-04-07 15:13 Bart Broersma Status assigned => resolved
2016-04-11 20:55 wp Note Added: 0091952
2016-04-11 20:55 wp Status resolved => feedback
2016-04-11 23:30 Bart Broersma Note Added: 0091954
2016-04-11 23:43 wp Note Added: 0091956
2016-04-11 23:43 wp Status feedback => assigned
2016-04-11 23:43 wp Status assigned => closed
2016-05-06 20:55 Zeljan Rikalo Relationship added has duplicate 0030104