LCL: Implement TTimeEdit. Patch by Michael Fuchs, modified by me.

git-svn-id: trunk@49566 -

.gitattributes

@@ -6525,6 +6525,8 @@ lcl/forms/finddlgunit.lfm svneol=native#text/plain
 lcl/forms/finddlgunit.pas svneol=native#text/plain
 lcl/forms/replacedlgunit.lfm svneol=native#text/plain
 lcl/forms/replacedlgunit.pas svneol=native#text/plain
+lcl/forms/timepopup.lfm svneol=native#text/plain
+lcl/forms/timepopup.pas svneol=native#text/pascal
 lcl/fpmake.pp svneol=native#text/plain
 lcl/graphics.pp svneol=native#text/pascal
 lcl/graphmath.pp svneol=native#text/pascal

images/components_images_list.txt

@@ -105,6 +105,7 @@ components/tstatictext.png
 components/tstatusbar.png
 components/tstringgrid.png
 components/ttabcontrol.png
+components/ttimeedit.png
 components/ttimer.png
 components/ttogglebox.png
 components/ttoolbar.png

lcl/alllclunits.pp

@@ -2,7 +2,7 @@
   This source is only used to compile and install the package.
  }
 
-unit AllLCLUnits;
+unit alllclunits;
 
 interface
 
@@ -16,15 +16,15 @@ uses
   LCLMessageGlue, LCLProc, LCLResCache, LCLStrConsts, LCLType, Menus, 
   LCLUnicodeData, LCLVersion, LMessages, LResources, Maps, MaskEdit, 
   PairSplitter, PopupNotifier, PostScriptCanvas, PostScriptPrinter, 
-  postscriptunicode, Printers, PropertyStorage, RubberBand, ShellCtrls, Spin, 
+  PostScriptUnicode, Printers, PropertyStorage, RubberBand, ShellCtrls, Spin, 
   StdActns, StdCtrls, StringHashList, TextStrings, Themes, TmSchema, Toolwin, 
-  Translations, UTrace, XMLPropStorage, Messages, WSButtons, WSCalendar, 
-  WSCheckLst, WSComCtrls, WSControls, WSDesigner, WSDialogs, WSExtCtrls, 
-  WSExtDlgs, WSFactory, WSForms, WSGrids, WSImgList, WSLCLClasses, WSMenus, 
-  WSPairSplitter, WSProc, WSReferences, WSSpin, WSStdCtrls, WSToolwin, 
-  ActnList, AsyncProcess, ButtonPanel, Buttons, Calendar, RegisterLCL, 
-  ValEdit, LazCanvas, LazDialogs, LazRegions, CustomDrawn_Common, 
-  CustomDrawnControls, CustomDrawnDrawers, LazDeviceApis, LDockTree,
+  Translations, UTrace, XMLPropStorage, TimePopup, Messages, WSButtons, 
+  WSCalendar, WSCheckLst, WSComCtrls, WSControls, WSDesigner, WSDialogs, 
+  WSExtCtrls, WSExtDlgs, WSFactory, WSForms, WSGrids, WSImgList, WSLCLClasses, 
+  WSMenus, WSPairSplitter, WSProc, WSReferences, WSSpin, WSStdCtrls, 
+  WSToolwin, ActnList, AsyncProcess, ButtonPanel, Buttons, Calendar, 
+  RegisterLCL, ValEdit, LazCanvas, LazDialogs, LazRegions, CustomDrawn_Common, 
+  CustomDrawnControls, CustomDrawnDrawers, LazDeviceApis, LDockTree, 
   LazFreeTypeIntfDrawer, CustomDrawn_WinXP, CustomDrawn_Android, Arrow, 
   EditBtn, ComboEx, DBExtCtrls, CustomDrawn_Mac, LazarusPackageIntf;
 

lcl/editbtn.pas

@@ -32,7 +32,7 @@ interface
 uses
   Classes, SysUtils, LCLProc, LResources, LCLStrConsts, Types, LCLType, LMessages,
   Graphics, Controls, Forms, LazFileUtils, Dialogs, StdCtrls, Buttons, Calendar,
-  ExtDlgs, CalendarPopup, MaskEdit, Menus;
+  ExtDlgs, CalendarPopup, MaskEdit, Menus, StrUtils, DateUtils, TimePopup;
 
 const
   NullDate: TDateTime = 0;
@@ -860,7 +860,101 @@ type
     property TextHintFontColor;
     property TextHintFontStyle;
   end;
+  
+  { TTimeEdit }
 
+  TAcceptTimeEvent = procedure (Sender : TObject; var ATime : TDateTime; var AcceptTime: Boolean) of object;
+  TCustomTimeEvent = procedure (Sender : TObject; var ATime : TDateTime) of object;
+
+  TTimeEdit = class(TCustomEditButton)
+    private
+      FTime: TTime;
+      IsEmptyTime: Boolean;
+      FDefaultNow: Boolean;
+      FDroppedDown: Boolean;
+      FOnAcceptTime: TAcceptTimeEvent;
+      FOnCustomTime: TCustomTimeEvent;
+      function GetTime: TDateTime;
+      procedure SetTime(AValue: TDateTime);
+      procedure SetEmptyTime;
+      procedure TimePopupReturnTime(Sender: TObject; const ATime: TDateTime);
+      procedure TimePopupShowHide(Sender: TObject);
+      procedure OpenTimePopup;
+      procedure ParseInput;
+      function TryParseInput(AInput: String; out ParseResult: TDateTime): Boolean;
+    protected
+      function GetDefaultGlyph: TBitmap; override;
+      function GetDefaultGlyphName: String; override;
+      procedure ButtonClick; override;
+      procedure EditDblClick; override;
+      procedure EditExit; override;
+      procedure EditKeyDown(var Key: word; Shift: TShiftState); override;
+    public
+      constructor Create(AOwner: TComponent); override;
+      property Time: TDateTime read GetTime write SetTime;
+      property Button;
+      property DroppedDown: Boolean read FDroppedDown;
+    published
+      property DefaultNow: Boolean read FDefaultNow write FDefaultNow default False;
+      property OnAcceptTime: TAcceptTimeEvent read FOnAcceptTime write FOnAcceptTime;
+      property OnCustomTime: TCustomTimeEvent read FOnCustomTime write FOnCustomTime;
+      property ReadOnly;
+      property ButtonOnlyWhenFocused;
+      property ButtonWidth;
+      property Action;
+      property Align;
+      property Anchors;
+      property AutoSize;
+      property AutoSelect;
+      property BidiMode;
+      property BorderSpacing;
+      property BorderStyle;
+      property CharCase;
+      property Color;
+      property Constraints;
+      property DirectInput;
+      property Glyph;
+      property NumGlyphs;
+      property DragMode;
+      property EchoMode;
+      property Enabled;
+      property Flat;
+      property FocusOnButtonClick;
+      property Font;
+      property MaxLength;
+      property OnButtonClick;
+      property OnChange;
+      property OnChangeBounds;
+      property OnClick;
+      property OnDblClick;
+      property OnEditingDone;
+      property OnEnter;
+      property OnExit;
+      property OnKeyDown;
+      property OnKeyPress;
+      property OnKeyUp;
+      property OnMouseDown;
+      property OnMouseEnter;
+      property OnMouseLeave;
+      property OnMouseMove;
+      property OnMouseUp;
+      property OnMouseWheel;
+      property OnMouseWheelDown;
+      property OnMouseWheelUp;
+      property OnResize;
+      property OnUTF8KeyPress;
+      property ParentBidiMode;
+      property ParentColor;
+      property ParentFont;
+      property ParentShowHint;
+      property PopupMenu;
+      property ShowHint;
+      property TabStop;
+      property TabOrder;
+      property Visible;
+      property Text;
+  end;
+  
 
   { TCalcEdit }
 
@@ -962,6 +1056,7 @@ var
   FileOpenGlyph: TBitmap;
   DateGlyph: TBitmap;
   CalcGlyph: TBitmap;
+  TimeGlyph: TBitmap;
 
 const
   ResBtnListFilter = 'btnfiltercancel';
@@ -969,6 +1064,7 @@ const
   ResBtnSelDir     = 'btnseldir';
   ResBtnCalendar   = 'btncalendar';
   ResBtnCalculator = 'btncalculator';
+  ResBtnTime       = 'btntime';
 
 procedure Register;
 
@@ -2837,6 +2933,135 @@ begin
   end;
 end;
 
+{ TTimeEdit }
+
+function TTimeEdit.GetTime: TDateTime;
+begin
+  Result := FTime;
+  if IsEmptyTime then begin
+    if FDefaultNow then
+      Result := TimeOf(Now);
+  end else begin
+    if Assigned(FOnCustomTime) then
+      FOnCustomTime(Self, Result);
+  end;
+end;
+
+procedure TTimeEdit.SetTime(AValue: TDateTime);
+var
+  Output: String;
+begin
+  DateTimeToString(Output, DefaultFormatSettings.ShortTimeFormat, AValue);
+  Text := Output;
+  FTime := AValue;
+  IsEmptyTime := False;
+end;
+
+procedure TTimeEdit.SetEmptyTime;
+begin
+  Text := EmptyStr;
+  FTime := NullDate;
+  IsEmptyTime := True;
+end;
+
+procedure TTimeEdit.TimePopupReturnTime(Sender: TObject; const ATime: TDateTime);
+var
+  AcceptResult: Boolean;
+  ReturnedTime: TDateTime;
+begin
+  try
+    AcceptResult := True;
+    ReturnedTime := ATime;
+    if Assigned(FOnAcceptTime) then
+      FOnAcceptTime(Self, ReturnedTime, AcceptResult);
+    if AcceptResult then
+      Self.Time := ReturnedTime;
+  except
+    on E:Exception do
+      MessageDlg(E.Message, mtError, [mbOK], 0);
+  end;
+end;
+
+procedure TTimeEdit.TimePopupShowHide(Sender: TObject);
+begin
+  FDroppedDown := (Sender as TForm).Visible;
+end;
+
+procedure TTimeEdit.OpenTimePopup;
+var
+  PopupOrigin: TPoint;
+  ATime: TDateTime;
+begin
+  ParseInput;
+  PopupOrigin := ControlToScreen(Point(0, Height));
+  ATime := GetTime;
+  if ATime = NullDate then
+    ATime := SysUtils.Time;
+  ShowTimePopup(PopupOrigin, ATime, Self.DoubleBuffered, @TimePopupReturnTime, @TimePopupShowHide);
+end;
+
+function TTimeEdit.TryParseInput(AInput: String; out ParseResult: TDateTime): Boolean;
+begin
+  AInput := Trim(AInput);
+  if (Length(AInput) in [3..4]) and (not AnsiContainsStr(AInput, DefaultFormatSettings.TimeSeparator)) then begin
+    Insert(DefaultFormatSettings.TimeSeparator, AInput, Length(AInput) - 1);
+  end;
+  Result := TryStrToTime(AInput, ParseResult);
+end;
+
+procedure TTimeEdit.ParseInput;
+var
+  TmpResult: TDateTime;
+begin
+  if Trim(Text) = EmptyStr then
+    SetEmptyTime
+  else if TryParseInput(Self.Text, TmpResult) then
+    SetTime(TmpResult)
+  else
+    SetTime(FTime);
+end;
+
+function TTimeEdit.GetDefaultGlyph: TBitmap;
+begin
+  Result := TimeGlyph;
+end;
+
+function TTimeEdit.GetDefaultGlyphName: String;
+begin
+  Result := ResBtnTime;
+end;
+
+procedure TTimeEdit.ButtonClick;
+begin
+  inherited ButtonClick;
+  OpenTimePopup;
+end;
+
+procedure TTimeEdit.EditDblClick;
+begin
+  inherited EditDblClick;
+  OpenTimePopup;
+end;
+
+procedure TTimeEdit.EditExit;
+begin
+  inherited EditExit;
+  ParseInput;
+end;
+
+procedure TTimeEdit.EditKeyDown(var Key: word; Shift: TShiftState);
+begin
+  if Key = VK_RETURN then
+    ParseInput;
+  inherited EditKeyDown(Key, Shift);
+end;
+
+constructor TTimeEdit.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  SetEmptyTime;
+end;
+
 { TCalcEdit }
 
 function TCalcEdit.GetAsFloat: Double;
@@ -2916,7 +3141,7 @@ end;
 procedure Register;
 begin
   RegisterComponents('Misc', [TEditButton,TFileNameEdit,TDirectoryEdit,
-                              TDateEdit,TCalcEdit]);
+                              TDateEdit,TTimeEdit,TCalcEdit]);
 end;
 
 end.

lcl/forms/timepopup.lfm

@@ -0,0 +1,240 @@
+object TimePopupForm: TTimePopupForm
+  Left = 376
+  Height = 185
+  Top = 246
+  Width = 253
+  AutoSize = True
+  BorderIcons = []
+  BorderStyle = bsNone
+  Caption = 'TimePopupForm'
+  ClientHeight = 185
+  ClientWidth = 253
+  OnClose = FormClose
+  OnCreate = FormCreate
+  OnDeactivate = FormDeactivate
+  PopupMode = pmAuto
+  LCLVersion = '1.5'
+  object MainPanel: TPanel
+    Left = 0
+    Height = 185
+    Top = 0
+    Width = 253
+    Align = alClient
+    BevelOuter = bvNone
+    BorderWidth = 1
+    BorderStyle = bsSingle
+    ClientHeight = 181
+    ClientWidth = 249
+    Color = clWindow
+    ParentColor = False
+    TabOrder = 0
+    UseDockManager = False
+    object HoursGrid: TStringGrid
+      Left = 1
+      Height = 43
+      Top = 1
+      Width = 252
+      Align = alTop
+      AutoFillColumns = True
+      BorderStyle = bsNone
+      Color = clBtnFace
+      ColCount = 12
+      Constraints.MinHeight = 42
+      Constraints.MinWidth = 252
+      ExtendedSelect = False
+      FixedCols = 0
+      FixedRows = 0
+      GridLineWidth = 0
+      Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goDrawFocusSelected, goSmoothScroll, goSelectionActive]
+      RowCount = 2
+      ScrollBars = ssNone
+      TabOrder = 0
+      UseXORFeatures = True
+      OnDblClick = GridsDblClick
+      OnKeyDown = GridsKeyDown
+      ColWidths = (
+        21
+        21
+        21
+        21
+        21
+        21
+        21
+        21
+        21
+        21
+        21
+        21
+      )
+      Cells = (
+        24
+        0
+        0
+        '00'
+        0
+        1
+        '12'
+        1
+        0
+        '01'
+        1
+        1
+        '13'
+        2
+        0
+        '02'
+        2
+        1
+        '14'
+        3
+        0
+        '03'
+        3
+        1
+        '15'
+        4
+        0
+        '04'
+        4
+        1
+        '16'
+        5
+        0
+        '05'
+        5
+        1
+        '17'
+        6
+        0
+        '06'
+        6
+        1
+        '18'
+        7
+        0
+        '07'
+        7
+        1
+        '19'
+        8
+        0
+        '08'
+        8
+        1
+        '20'
+        9
+        0
+        '09'
+        9
+        1
+        '21'
+        10
+        0
+        '10'
+        10
+        1
+        '22'
+        11
+        0
+        '11'
+        11
+        1
+        '23'
+      )
+    end
+    object MinutesGrid: TStringGrid
+      Left = 1
+      Height = 59
+      Top = 61
+      Width = 252
+      Align = alTop
+      AutoFillColumns = True
+      BorderStyle = bsNone
+      ColCount = 6
+      Constraints.MinWidth = 252
+      FixedCols = 0
+      FixedRows = 0
+      Flat = True
+      GridLineWidth = 0
+      Options = [goFixedVertLine, goDrawFocusSelected, goSmoothScroll]
+      RowCount = 2
+      ScrollBars = ssNone
+      TabOrder = 1
+      UseXORFeatures = True
+      OnDblClick = GridsDblClick
+      OnKeyDown = GridsKeyDown
+      ColWidths = (
+        42
+        42
+        42
+        42
+        42
+        42
+      )
+      Cells = (
+        12
+        0
+        0
+        '00'
+        0
+        1
+        '30'
+        1
+        0
+        '05'
+        1
+        1
+        '35'
+        2
+        0
+        '10'
+        2
+        1
+        '40'
+        3
+        0
+        '15'
+        3
+        1
+        '45'
+        4
+        0
+        '20'
+        4
+        1
+        '50'
+        5
+        0
+        '25'
+        5
+        1
+        '55'
+      )
+    end
+    object Bevel1: TBevel
+      Left = 1
+      Height = 10
+      Top = 51
+      Width = 247
+      Align = alTop
+      BorderSpacing.Top = 7
+      Shape = bsTopLine
+    end
+    object MoreLessBtn: TBitBtn
+      AnchorSideTop.Control = MinutesGrid
+      AnchorSideTop.Side = asrBottom
+      AnchorSideRight.Control = MainPanel
+      AnchorSideRight.Side = asrBottom
+      Left = 155
+      Height = 22
+      Hint = 'Ctrl + >'
+      Top = 125
+      Width = 93
+      Anchors = [akTop, akLeft, akRight]
+      BorderSpacing.Top = 5
+      Caption = '>>'
+      OnClick = MoreLessBtnClick
+      TabOrder = 2
+    end
+  end
+end

lcl/forms/timepopup.pas

@@ -0,0 +1,263 @@
+{
+ *****************************************************************************
+  This file is part of the Lazarus Component Library (LCL)
+
+  See the file COPYING.modifiedLGPL.txt, included in this distribution,
+  for details about the license.
+ *****************************************************************************
+
+  Author: Michael Fuchs
+
+  Abstract:
+     Shows a time input popup for a TTimeEdit
+}
+
+unit TimePopup;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, DateUtils, FileUtil, LCLType, Forms, Controls,
+  Graphics, Dialogs, Grids, ExtCtrls, Buttons, StdCtrls, ActnList;
+
+type
+  TReturnTimeEvent = procedure (Sender: TObject; const ATime: TDateTime) of object;
+
+  { TTimePopupForm }
+  
+  TTimePopupForm = class(TForm)
+    Bevel1: TBevel;
+    MainPanel: TPanel;
+    HoursGrid: TStringGrid;
+    MinutesGrid: TStringGrid;
+    MoreLessBtn: TBitBtn;
+    procedure GridsDblClick(Sender: TObject);
+    procedure GridsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+    procedure MoreLessBtnClick(Sender: TObject);
+    procedure SetLayout(SimpleLayout: Boolean);
+  private
+    FClosed: Boolean;
+    FOnReturnTime: TReturnTimeEvent;
+    FSimpleLayout: Boolean;
+    procedure ActivateDoubleBuffered;
+    procedure CalcGridHeights;
+    function GetTime: TDateTime;
+    procedure Initialize(const PopupOrigin: TPoint; ATime: TDateTime);
+    procedure ReturnTime;
+    procedure SetTime(ATime: TDateTime);
+  published
+    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDeactivate(Sender: TObject);
+  end;
+
+procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean;
+                        const OnReturnTime: TReturnTimeEvent; const OnShowHide: TNotifyEvent = nil);
+
+implementation
+
+{$R *.lfm}
+
+procedure ShowTimePopup(const Position: TPoint; ATime: TDateTime; const DoubleBufferedForm: Boolean; const OnReturnTime: TReturnTimeEvent;
+                        const OnShowHide: TNotifyEvent);
+var
+  NewForm: TTimePopupForm;
+begin
+  NewForm := TTimePopupForm.Create(nil);
+  NewForm.Initialize(Position, ATime);
+  NewForm.FOnReturnTime := OnReturnTime;
+  NewForm.OnShow := OnShowHide;
+  NewForm.OnHide := OnShowHide;
+  if DoubleBufferedForm then
+    NewForm.ActivateDoubleBuffered;
+  NewForm.Show;
+end;
+
+procedure TTimePopupForm.SetTime(ATime: TDateTime);
+var
+  Hour, Minute: Integer;
+begin
+  Hour := HourOf(ATime);
+  Minute := MinuteOf(ATime);
+  HoursGrid.Col := Hour mod 12;
+  HoursGrid.Row := Hour div 12;
+  if FSimpleLayout then
+  begin
+    Minute := Minute - (Minute mod 5);
+    MinutesGrid.Col := (Minute mod 30) div 5;
+    MinutesGrid.Row := Minute div 30;
+  end
+  else
+  begin
+    MinutesGrid.Col := Minute  mod 5;
+    MinutesGrid.Row := Minute div 5;
+  end;
+end;
+
+procedure TTimePopupForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
+begin
+  FClosed := true;
+  Application.RemoveOnDeactivateHandler(@FormDeactivate);
+  CloseAction := caFree;
+end;
+
+procedure TTimePopupForm.FormCreate(Sender: TObject);
+begin
+  FClosed := False;
+  FSimpleLayout := True;
+  Application.AddOnDeactivateHandler(@FormDeactivate);
+  SetLayout(FSimpleLayout);
+end;
+
+procedure TTimePopupForm.FormDeactivate(Sender: TObject);
+begin
+  if (not FClosed) then
+    Close;
+end;
+
+procedure TTimePopupForm.GridsDblClick(Sender: TObject);
+begin
+  ReturnTime;
+end;
+
+procedure TTimePopupForm.GridsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+var
+  Handled: Boolean;
+begin
+  if Shift=[] then begin
+    Handled := True;
+    case Key of
+      VK_ESCAPE          : Close;
+      VK_RETURN, VK_SPACE: ReturnTime;
+    else
+      Handled := False;
+    end;
+    if Handled then
+      Key := 0;
+  end;
+end;
+
+procedure TTimePopupForm.MoreLessBtnClick(Sender: TObject);
+var
+  OldMin: Integer;
+begin
+  if FSimpleLayout then
+  begin
+    OldMin := (MinutesGrid.Row * 30) + (MinutesGrid.Col * 5);
+    if (OldMin < 0) then OldMin := 0;
+    if (OldMin > 59) then OldMin := 59;
+    SetLayout(False);
+
+    MinutesGrid.Col := OldMin mod 5;
+    MinutesGrid.Row := OldMin div 5;
+    MoreLessBtn.Caption := '<<';
+  end
+  else
+  begin
+    OldMin := (MinutesGrid.Row * 5) + (MinutesGrid.Col);
+    if (OldMin < 0) then OldMin := 0;
+    if (OldMin > 59) then OldMin := 59;
+    OldMin := OldMin - (OldMin mod 5);
+    SetLayout(True);
+    MinutesGrid.Col := (OldMin mod 30) div 5;
+    MinutesGrid.Row := OldMin div 30;
+    MoreLessBtn.Caption := '>>';
+  end;
+end;
+
+procedure TTimePopupForm.SetLayout(SimpleLayout: Boolean);
+var
+  r, c: Integer;
+begin
+  MinutesGrid.BeginUpdate;
+  try
+  if SimpleLayout then
+  begin
+    MinutesGrid.RowCount := 2;
+    MinutesGrid.ColCount := 6;
+    for r := 0 to MinutesGrid.RowCount - 1 do
+      for c := 0 to MinutesGrid.ColCount - 1 do
+        begin
+          //debugln(Format('[%.2d,%.2d]: %.2d',[r,c,(r*30) + (c*5)]));
+          MinutesGrid.Cells[c,r] := Format('%s%.2d',[DefaultFormatSettings.TimeSeparator,(r*30) + (c*5)]);
+        end;
+  end
+  else
+  begin
+    MinutesGrid.RowCount := 12;
+    MinutesGrid.ColCount := 5;
+    for r := 0 to MinutesGrid.RowCount - 1 do
+      for c := 0 to MinutesGrid.ColCount - 1 do
+        begin
+          //debugln(Format('[%.2d,%.2d]: %.2d',[r,c,(r*5) + (c)]));
+          MinutesGrid.Cells[c,r] := Format('%s%.2d',[DefaultFormatSettings.TimeSeparator,(r*5) + (c)]);
+        end;
+  end;
+  CalcGridHeights;
+  FSimpleLayout := SimpleLayout;
+  finally
+    MinutesGrid.EndUpdate(True);
+  end;
+end;
+
+procedure TTimePopupForm.ActivateDoubleBuffered;
+begin
+  Self.DoubleBuffered := True;
+  HoursGrid.DoubleBuffered := True;
+  MinutesGrid.DoubleBuffered := True;
+end;
+
+procedure TTimePopupForm.CalcGridHeights;
+var
+  i, RowHeightsSum: Integer;
+begin
+  RowHeightsSum := 0;
+  for i := 0 to HoursGrid.RowCount - 1 do
+    RowHeightsSum := RowHeightsSum + HoursGrid.RowHeights[i] + 1;
+  HoursGrid.Constraints.MinHeight := RowHeightsSum;
+  RowHeightsSum := 0;
+  for i := 0 to MinutesGrid.RowCount - 1 do
+    RowHeightsSum := RowHeightsSum + MinutesGrid.RowHeights[i] + 1;
+  MinutesGrid.Constraints.MinHeight := RowHeightsSum;
+  MinutesGrid.Height := RowHeightsSum;
+end;
+
+function TTimePopupForm.GetTime: TDateTime;
+var
+  Hour, Minute: Integer;
+begin
+  Hour := (HoursGrid.Row * 12) + (HoursGrid.Col);
+  if FSimpleLayout then
+    Minute := (MinutesGrid.Row * 30) + (MinutesGrid.Col * 5)
+  else
+    Minute := (MinutesGrid.Row * 5) + (MinutesGrid.Col);
+  Result := EncodeTime(Hour, Minute, 0, 0);
+end;
+
+procedure TTimePopupForm.Initialize(const PopupOrigin: TPoint; ATime: TDateTime);
+var
+  ABounds: TRect;
+begin
+  ABounds := Screen.MonitorFromPoint(PopupOrigin).BoundsRect;
+  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
+    Top := PopupOrigin.Y;
+  SetTime(ATime);
+end;
+
+procedure TTimePopupForm.ReturnTime;
+begin
+  if Assigned(FOnReturnTime) then
+    FOnReturnTime(Self, Self.GetTime);
+  if not FClosed then
+    Close;
+end;
+
+end.

lcl/images/lcl_edbtnimg_list.txt

@@ -3,3 +3,4 @@ btncalculator.png
 btncalendar.png
 btnseldir.png
 btnselfile.png
+btntime.png