1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
{ $Id$}
{
*****************************************************************************
* GtkWSCalendar.pp *
* ---------------- *
* *
* *
*****************************************************************************
*****************************************************************************
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.
*****************************************************************************
}
unit GtkWSCalendar;
{$mode objfpc}{$H+}
interface
uses
// Bindings
{$IFDEF gtk2}
glib2, gdk2pixbuf, gdk2, gtk2, Pango,
{$ELSE}
glib, gdk, gtk, gdkpixbuf, GtkFontCache,
{$ENDIF}
// RTL, FCL, LCL
SysUtils, Classes, Controls, Calendar, LCLType, LMessages,
InterfaceBase,
// Widgetset
GtkProc, GtkDef, GtkInt, GtkWsControls,
WSCalendar, WSLCLClasses, WSProc;
type
{ TGtkWSCustomCalendar }
TGtkWSCustomCalendar = class(TWSCustomCalendar)
private
protected
class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
class function GetCalendar(const ACalendar: TCustomCalendar): PGtkCalendar; inline;
published
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLHandle; override;
class function GetDateTime(const ACalendar: TCustomCalendar): TDateTime; override;
class procedure SetDateTime(const ACalendar: TCustomCalendar; const ADateTime: TDateTime); override;
class procedure SetDisplaySettings(const ACalendar: TCustomCalendar;
const ADisplaySettings: TDisplaySettings); override;
end;
implementation
class procedure TGtkWSCustomCalendar.SetCallbacks(const AGtkWidget: PGtkWidget;
const AWidgetInfo: PWidgetInfo);
begin
TGtkWSWinControl.SetCallbacks(PGtkObject(AGtkWidget), TComponent(AWidgetInfo^.LCLObject));
with TGtkWidgetset(Widgetset) do
begin
SetCallback(LM_MONTHCHANGED, PGtkObject(AGtkWidget), AWidgetInfo^.LCLObject);
SetCallback(LM_YEARCHANGED, PGtkObject(AGtkWidget), AWidgetInfo^.LCLObject);
SetCallback(LM_DAYCHANGED, PGtkObject(AGtkWidget), AWidgetInfo^.LCLObject);
end;
end;
class function TGtkWSCustomCalendar.GetCalendar(const ACalendar: TCustomCalendar): PGtkCalendar; inline;
begin
Result := PGtkCalendar(GetWidgetInfo(PGtkWidget(ACalendar.Handle))^.CoreWidget);
end;
class function TGtkWSCustomCalendar.CreateHandle(
const AWinControl: TWinControl; const AParams: TCreateParams
): TLCLHandle;
var
FrameWidget, CalendarWidget: PGtkWidget;
WidgetInfo: PWidgetInfo;
Allocation: TGtkAllocation;
begin
FrameWidget := gtk_frame_new(nil);
CalendarWidget := gtk_calendar_new();
gtk_container_add(PGtkContainer(FrameWidget), CalendarWidget);
gtk_widget_show_all(FrameWidget);
Result := TLCLHandle(PtrUInt(FrameWidget));
{$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(FrameWidget, dbgsName(AWinControl));
{$ENDIF}
WidgetInfo := CreateWidgetInfo(FrameWidget, AWinControl, AParams);
WidgetInfo^.CoreWidget := CalendarWidget;
SetMainWidget(FrameWidget, CalendarWidget);
Allocation.X := AParams.X;
Allocation.Y := AParams.Y;
Allocation.Width := AParams.Width;
Allocation.Height := AParams.Height;
gtk_widget_size_allocate(PGtkWidget(Result), @Allocation);
Set_RC_Name(AWinControl, FrameWidget);
SetCallBacks(FrameWidget, WidgetInfo);
end;
class function TGtkWSCustomCalendar.GetDateTime(const ACalendar: TCustomCalendar): TDateTime;
var
Year, Month, Day: guint; //used for csCalendar
begin
Result := 0;
if not WSCheckHandleAllocated(ACalendar, 'GetDateTime') then
Exit;
gtk_calendar_get_date(GetCalendar(ACalendar), @Year, @Month, @Day);
//For some reason, the month is zero based.
Result := EncodeDate(Year, Month + 1, Day);
end;
class procedure TGtkWSCustomCalendar.SetDateTime(const ACalendar: TCustomCalendar; const ADateTime: TDateTime);
var
Year, Month, Day: string;
GtkCalendar: PGtkCalendar;
begin
if not WSCheckHandleAllocated(ACalendar, 'SetDateTime') then
Exit;
GtkCalendar := GetCalendar(ACalendar);
Year := FormatDateTime('yyyy', ADateTime);
Month := FormatDateTime('mm', ADateTime);
Day := FormatDateTime('dd', ADateTime);
gtk_calendar_select_month(GtkCalendar, StrtoInt(Month) - 1, StrToInt(Year));
gtk_calendar_select_day(GtkCalendar, StrToInt(Day));
end;
class procedure TGtkWSCustomCalendar.SetDisplaySettings(const ACalendar: TCustomCalendar;
const ADisplaySettings: TDisplaySettings);
var
num: dword;
gtkcalendardisplayoptions : TGtkCalendarDisplayOptions;
begin
if not WSCheckHandleAllocated(ACalendar, 'SetDisplaySettings') then
Exit;
num := 0;
if (dsShowHeadings in ADisplaySettings) then
num := Num + (1 shl 0);
if (dsShowDayNames in ADisplaySettings) then
num := Num + (1 shl 1);
if (dsNoMonthChange in ADisplaySettings) then
num := Num + (1 shl 2);
if (dsShowWeekNumbers in ADisplaySettings) then
num := Num + (1 shl 3);
{
if (dsStartMonday in ADisplaySettings) then
num := Num + (1 shl 4);
}
gtkCalendarDisplayOptions := TGtkCalendarDisplayOptions(num);
gtk_Calendar_Display_options(GetCalendar(ACalendar), gtkCalendarDisplayOptions);
end;
end.
|
