1{ 2 ***************************************************************************** 3 * QtWSCalendar.pp * 4 * --------------- * 5 * * 6 * * 7 ***************************************************************************** 8 9 ***************************************************************************** 10 This file is part of the Lazarus Component Library (LCL) 11 12 See the file COPYING.modifiedLGPL.txt, included in this distribution, 13 for details about the license. 14 ***************************************************************************** 15} 16unit QtWSCalendar; 17 18{$mode objfpc}{$H+} 19 20interface 21 22{$I qtdefines.inc} 23 24uses 25 // Bindings 26 qt5, 27 qtwidgets, 28 // LCL 29 SysUtils, Types, DateUtils, Controls, Calendar, LCLType, LCLIntf, LCLProc, 30 // Widgetset 31 WSProc, WSCalendar, WSLCLClasses; 32 33type 34 35 { TQtWSCustomCalendar } 36 37 TQtWSCustomCalendar = class(TWSCustomCalendar) 38 published 39 class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override; 40 class function GetDateTime(const ACalendar: TCustomCalendar): TDateTime; override; 41 class function HitTest(const ACalendar: TCustomCalendar; const APoint: TPoint): TCalendarPart; override; 42 class procedure SetDateTime(const ACalendar: TCustomCalendar; const ADateTime: TDateTime); override; 43 class procedure SetDisplaySettings(const ACalendar: TCustomCalendar; const ADisplaySettings: TDisplaySettings); override; 44 end; 45 46 47implementation 48 49{ TQtWSCustomCalendar } 50 51class function TQtWSCustomCalendar.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; 52var 53 QtCalendar: TQtCalendar; 54begin 55 QtCalendar := TQtCalendar.Create(AWinControl, AParams); 56 57 QtCalendar.AttachEvents; 58 59 Result := TLCLIntfHandle(QtCalendar); 60end; 61 62class function TQtWSCustomCalendar.GetDateTime(const ACalendar: TCustomCalendar): TDateTime; 63var 64 QtCalendar: TQtCalendar; 65begin 66 QtCalendar := TQtCalendar(ACalendar.Handle); 67 Result := QtCalendar.DateTime; 68end; 69 70class function TQtWSCustomCalendar.HitTest(const ACalendar: TCustomCalendar; 71 const APoint: TPoint): TCalendarPart; 72var 73 QtCalendar: TQtCalendar; 74begin 75 Result := cpNoWhere; 76 if not WSCheckHandleAllocated(ACalendar, 'HitTest') then 77 Exit; 78 QtCalendar := TQtCalendar(ACalendar.Handle); 79 Result := TCalendarPart(QtCalendar.HitTest(APoint)) 80end; 81 82class procedure TQtWSCustomCalendar.SetDateTime(const ACalendar: TCustomCalendar; 83 const ADateTime: TDateTime); 84var 85 QtCalendar: TQtCalendar; 86begin 87 QtCalendar := TQtCalendar(ACalendar.Handle); 88 QtCalendar.BeginUpdate; 89 QtCalendar.DateTime := ADateTime; 90 QtCalendar.EndUpdate; 91end; 92 93class procedure TQtWSCustomCalendar.SetDisplaySettings(const ACalendar: TCustomCalendar; 94 const ADisplaySettings: TDisplaySettings); 95var 96 QtCalendar: TQtCalendar; 97 HHdrFmt: QCalendarWidgetHorizontalHeaderFormat; 98 VHdrFmt: QCalendarWidgetVerticalHeaderFormat; 99 SelMode: QCalendarWidgetSelectionMode; 100begin 101 QtCalendar := TQtCalendar(ACalendar.Handle); 102 103 SelMode := QCalendarWidgetSingleSelection; 104 105 if dsShowDayNames in ADisplaySettings then 106 HHdrFmt := QCalendarWidgetShortDayNames 107 else 108 HHdrFmt := QCalendarWidgetNoHorizontalHeader; 109 110 if dsShowWeekNumbers in ADisplaySettings then 111 VHdrFmt := QCalendarWidgetISOWeekNumbers 112 else 113 VHdrFmt := QCalendarWidgetNoVerticalHeader; 114 115 QtCalendar.BeginUpdate; 116 QtCalendar.SetDisplaySettings(HHdrFmt, VHdrFmt, SelMode, 117 dsShowHeadings in ADisplaySettings, dsShowWeekNumbers in ADisplaySettings, 118 dsStartMonday in ADisplaySettings); 119 QtCalendar.EndUpdate; 120end; 121 122end. 123