1{ $Id$}
2{
3 *****************************************************************************
4 *                             Gtk2WSCalendar.pp                             *
5 *                             -----------------                             *
6 *                                                                           *
7 *                                                                           *
8 *****************************************************************************
9
10 *****************************************************************************
11  This file is part of the Lazarus Component Library (LCL)
12
13  See the file COPYING.modifiedLGPL.txt, included in this distribution,
14  for details about the license.
15 *****************************************************************************
16}
17unit Gtk2WSCalendar;
18
19{$mode objfpc}{$H+}
20
21interface
22
23uses
24  // RTL
25  glib2, gdk2, gtk2, SysUtils, Types, Classes,
26  // RTL, FCL, LCL
27  Controls, Calendar, LCLType, LMessages,
28  InterfaceBase, LCLProc,
29  // Widgetset
30  Gtk2Proc, Gtk2Def, Gtk2Int, Gtk2WsControls,
31  WSCalendar, WSLCLClasses, WSProc;
32
33type
34
35  { TGtk2WSCalendar }
36
37  { TGtk2WSCustomCalendar }
38
39  TGtk2WSCustomCalendar = class(TWSCustomCalendar)
40  protected
41    class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
42    class function GetCalendar(const ACalendar: TCustomCalendar): PGtkCalendar; //inline;
43  published
44    class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
45    class procedure DestroyHandle(const AWinControl: TWinControl); override;
46    class function GetDateTime(const ACalendar: TCustomCalendar): TDateTime; override;
47    class function HitTest(const ACalendar: TCustomCalendar; const APoint: TPoint): TCalendarPart; override;
48    class procedure SetDateTime(const ACalendar: TCustomCalendar; const ADateTime: TDateTime); override;
49    class procedure SetDisplaySettings(const ACalendar: TCustomCalendar;
50      const ADisplaySettings: TDisplaySettings); override;
51    class procedure GetPreferredSize(const AWinControl: TWinControl;
52                        var PreferredWidth, PreferredHeight: integer;
53                        WithThemeSpace: Boolean); override;
54  end;
55
56
57implementation
58
59type
60  TGtkCalendarPrivate = record
61    header_win: PGdkWindow;
62    day_name_win: PGdkWindow;
63    main_win: PGdkWindow;
64    week_win: PGdkWindow;
65    arrow_win: array[0..3] of PGdkWindow;
66
67    header_h: guint;
68    day_name_h: guint;
69    main_h: guint;
70
71    arrow_state: array[0..3] of guint;
72    arrow_width: guint;
73    max_month_width: guint;
74    max_year_width: guint;
75
76    day_width: guint;
77    week_width: guint;
78
79    min_day_width: guint;
80    max_day_char_width: guint;
81    max_day_char_ascent: guint;
82    max_day_char_descent: guint;
83    max_label_char_ascent: guint;
84    max_label_char_descent: guint;
85    max_week_char_width: guint;
86  end;
87  PGtkCalendarPrivate = ^TGtkCalendarPrivate;
88  TGtkCalendarInternalTimer = record
89    ACalendar : TCustomCalendar;
90    gtkcalendardisplayoptions: TGtkCalendarDisplayOptions;
91    ATimerSourceID: guint;
92  end;
93  PGtkCalendarInternalTimer = ^TGtkCalendarInternalTimer;
94
95function SetCalendarDisplayOptionsTimer(data: gpointer): gboolean; cdecl;
96Var
97  AGtkCalendarInternalTimer : PGtkCalendarInternalTimer absolute data;
98  AGtkCalendar: PGtkCalendar;
99begin
100  Result := False;
101  AGtkCalendar := TGtk2WSCustomCalendar.GetCalendar(AGtkCalendarInternalTimer^.ACalendar);
102  gtk_Calendar_Display_options(AGtkCalendar, AGtkCalendarInternalTimer^.gtkcalendardisplayoptions);
103  g_source_remove(AGtkCalendarInternalTimer^.ATimerSourceID);
104  Dispose(AGtkCalendarInternalTimer);
105end;
106
107{ TGtk2WSCustomCalendar }
108
109class procedure TGtk2WSCustomCalendar.SetCallbacks(const AGtkWidget: PGtkWidget;
110  const AWidgetInfo: PWidgetInfo);
111begin
112  TGtk2WSWinControl.SetCallbacks(PGtkObject(AGtkWidget), TComponent(AWidgetInfo^.LCLObject));
113  with TGtk2Widgetset(Widgetset) do
114  begin
115    SetCallback(LM_MONTHCHANGED, PGtkObject(AGtkWidget), AWidgetInfo^.LCLObject);
116    SetCallback(LM_YEARCHANGED, PGtkObject(AGtkWidget), AWidgetInfo^.LCLObject);
117    SetCallback(LM_DAYCHANGED, PGtkObject(AGtkWidget), AWidgetInfo^.LCLObject);
118  end;
119  g_signal_handlers_disconnect_by_func(PGtkObject(AWidgetInfo^.CoreWidget),
120      TGTKSignalFunc(@GtkDragDataReceived), AWidgetInfo^.LCLObject);
121end;
122
123class function TGtk2WSCustomCalendar.GetCalendar(const ACalendar: TCustomCalendar): PGtkCalendar; //inline;
124begin
125  Result := PGtkCalendar(GetWidgetInfo({%H-}PGtkWidget(ACalendar.Handle))^.CoreWidget);
126end;
127
128class function TGtk2WSCustomCalendar.CreateHandle(
129  const AWinControl: TWinControl; const AParams: TCreateParams
130  ): TLCLIntfHandle;
131var
132  FrameWidget, CalendarWidget: PGtkWidget;
133  WidgetInfo: PWidgetInfo;
134  Allocation: TGtkAllocation;
135  Requisition: TGtkRequisition;
136begin
137  FrameWidget := gtk_frame_new(nil);
138  CalendarWidget := gtk_calendar_new();
139  gtk_container_add(PGtkContainer(FrameWidget), CalendarWidget);
140  gtk_widget_show_all(FrameWidget);
141  // if we don't request it - we have a SIGFPE sometimes
142  gtk_widget_size_request(CalendarWidget, @Requisition);
143
144  Result := TLCLIntfHandle({%H-}PtrUInt(FrameWidget));
145  {$IFDEF DebugLCLComponents}
146  DebugGtkWidgets.MarkCreated(FrameWidget, dbgsName(AWinControl));
147  {$ENDIF}
148
149  WidgetInfo := CreateWidgetInfo(FrameWidget, AWinControl, AParams);
150  WidgetInfo^.CoreWidget := CalendarWidget;
151  SetMainWidget(FrameWidget, CalendarWidget);
152
153  Allocation.X := AParams.X;
154  Allocation.Y := AParams.Y;
155  Allocation.Width := AParams.Width;
156  Allocation.Height := AParams.Height;
157  gtk_widget_size_allocate({%H-}PGtkWidget(Result), @Allocation);
158
159  Set_RC_Name(AWinControl, FrameWidget);
160  SetCallBacks(FrameWidget, WidgetInfo);
161end;
162
163class procedure TGtk2WSCustomCalendar.DestroyHandle(
164  const AWinControl: TWinControl);
165begin
166  TGtk2WSWinControl.DestroyHandle(AWinControl);
167  //inherited DestroyHandle(AWinControl);
168end;
169
170class function TGtk2WSCustomCalendar.GetDateTime(const ACalendar: TCustomCalendar): TDateTime;
171var
172  Year, Month, Day: guint;  //used for csCalendar
173begin
174  Result := 0;
175  if not WSCheckHandleAllocated(ACalendar, 'GetDateTime') then
176    Exit;
177  gtk_calendar_get_date(GetCalendar(ACalendar), @Year, @Month, @Day);
178  //For some reason, the month is zero based.
179  Result := EncodeDate(Year, Month + 1, Day);
180end;
181
182class function TGtk2WSCustomCalendar.HitTest(const ACalendar: TCustomCalendar;
183  const APoint: TPoint): TCalendarPart;
184var
185  GtkCalendar: PGtkCalendar;
186  Style: PGtkStyle;
187  FrameW, FrameH, BodyY, BodyX, DayH, ArrowW: Integer;
188  Options: TGtkCalendarDisplayOptions;
189  R: TRect;
190begin
191  Result := cpNoWhere;
192  if not WSCheckHandleAllocated(ACalendar, 'HitTest') then
193    Exit;
194
195  GtkCalendar := GetCalendar(ACalendar);
196  Style := gtk_widget_get_style({%H-}PGtkWidget(ACalendar.Handle));
197  FrameW := gtk_widget_get_xthickness(Style);
198  FrameH := gtk_widget_get_Ythickness(Style);
199
200  Options := gtk_calendar_get_display_options(GtkCalendar);
201
202  if Ord(Options) and Ord(GTK_CALENDAR_SHOW_HEADING) <> 0 then
203    BodyY := PGtkCalendarPrivate(GtkCalendar^.private_data)^.header_h
204  else
205    BodyY := 0;
206
207  if Ord(Options) and Ord(GTK_CALENDAR_SHOW_WEEK_NUMBERS) <> 0 then
208    BodyX := PGtkCalendarPrivate(GtkCalendar^.private_data)^.week_width
209  else
210    BodyX := 0;
211
212  if APoint.Y >= BodyY + FrameH then
213  begin
214    // we are in the body
215    if Ord(Options) and Ord(GTK_CALENDAR_SHOW_DAY_NAMES) <> 0 then
216      DayH := PGtkCalendarPrivate(GtkCalendar^.private_data)^.day_name_h
217    else
218      DayH := 0;
219
220    if (APoint.Y - BodyY - DayH - FrameH >= 0) then
221    begin
222      if APoint.X >= BodyX + FrameW then
223        Result := cpDate
224      else
225        Result := cpWeekNumber;
226    end;
227  end
228  else
229  if BodyY > 0 then
230  begin
231    Result := cpTitle; // we are in the header at least
232
233    ArrowW := PGtkCalendarPrivate(GtkCalendar^.private_data)^.arrow_width;
234
235    R.Top := 3 + FrameH;
236    R.Bottom := BodyY - 7 + FrameH;
237    R.Left := 3 + FrameW;
238    // check month + buttons
239    R.Right := R.Left + ArrowW + 1;
240    if PtInRect(R, APoint) then
241      Exit(cpTitleBtn);
242    R.Left := R.Right + 1;
243    R.Right := FrameW + ArrowW + integer(PGtkCalendarPrivate(GtkCalendar^.private_data)^.max_month_width) + 1;
244    if PtInRect(R, APoint) then
245      Exit(cpTitleMonth);
246    R.Left := R.Right;
247    R.Right := R.Left + ArrowW;
248    if PtInRect(R, APoint) then
249      Exit(cpTitleBtn);
250    // check year + buttons
251    Style := gtk_widget_get_style(PGtkWidget(GtkCalendar));
252    R.Right := PGtkWidget(GtkCalendar)^.allocation.width - 3 -
253      2 * gtk_widget_get_xthickness(Style) + FrameW + 1;
254    R.Left := R.Right - ArrowW;
255    if PtInRect(R, APoint) then
256      Exit(cpTitleBtn);
257    R.Right := R.Left;
258    R.Left := R.Right - PGtkCalendarPrivate(GtkCalendar^.private_data)^.max_year_width;
259    if PtInRect(R, APoint) then
260      Exit(cpTitleYear);
261    R.Right := R.Left;
262    R.Left := R.Right - ArrowW;
263    if PtInRect(R, APoint) then
264      Exit(cpTitleBtn);
265  end;
266end;
267
268class procedure TGtk2WSCustomCalendar.SetDateTime(const ACalendar: TCustomCalendar; const ADateTime: TDateTime);
269var
270  Year, Month, Day: string;
271  GtkCalendar: PGtkCalendar;
272begin
273  if not WSCheckHandleAllocated(ACalendar, 'SetDateTime') then
274    Exit;
275  GtkCalendar := GetCalendar(ACalendar);
276  Year := FormatDateTime('yyyy', ADateTime);
277  Month := FormatDateTime('mm', ADateTime);
278  Day := FormatDateTime('dd', ADateTime);
279  gtk_calendar_select_month(GtkCalendar, StrtoInt(Month) - 1, StrToInt(Year));
280  gtk_calendar_select_day(GtkCalendar, StrToInt(Day));
281end;
282
283class procedure TGtk2WSCustomCalendar.SetDisplaySettings(const ACalendar: TCustomCalendar;
284  const ADisplaySettings: TDisplaySettings);
285var
286  num: dword;
287  gtkcalendardisplayoptions : TGtkCalendarDisplayOptions;
288  AGtkCalendarInternalTimer : PGtkCalendarInternalTimer;
289begin
290  if not WSCheckHandleAllocated(ACalendar, 'SetDisplaySettings') then
291    Exit;
292
293  num := 0;
294  if (dsShowHeadings in ADisplaySettings) then
295    num := Num + (1 shl 0);
296
297  if (dsShowDayNames in ADisplaySettings) then
298    num := Num  + (1 shl 1);
299
300  if (dsNoMonthChange in ADisplaySettings) then
301    num := Num  + (1 shl 2);
302
303  if (dsShowWeekNumbers in ADisplaySettings) then
304    num := Num  + (1 shl 3);
305
306  {
307  if (dsStartMonday in ADisplaySettings) then
308    num := Num  + (1 shl 4);
309  }
310  gtkCalendarDisplayOptions := TGtkCalendarDisplayOptions(num);
311
312  New(AGtkCalendarInternalTimer);
313  AGtkCalendarInternalTimer^.ACalendar := ACalendar;
314  AGtkCalendarInternalTimer^.gtkcalendardisplayoptions := gtkCalendarDisplayOptions;
315  AGtkCalendarInternalTimer^.ATimerSourceID := g_timeout_add(1, @SetCalendarDisplayOptionsTimer, AGtkCalendarInternalTimer);
316end;
317
318class procedure TGtk2WSCustomCalendar.GetPreferredSize(
319  const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer;
320  WithThemeSpace: Boolean);
321begin
322  GetGTKDefaultWidgetSize(AWinControl, PreferredWidth, PreferredHeight,
323                          WithThemeSpace);
324end;
325
326end.
327