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
|
{ $Id: win32wscalendar.pp 17576 2008-11-25 02:29:28Z paul $}
{
*****************************************************************************
* WinCEWSCalendar.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 WinCEWSCalendar;
{$mode objfpc}{$H+}
interface
uses
// Libs
commctrl,
Windows,
// LCL
Calendar, SysUtils, Controls, LCLType,
// Widgetset
WSProc, WSCalendar, WSLCLClasses, WinCEDef, WinCEWSControls;
type
{ TWinCEWSCustomCalendar }
TWinCEWSCustomCalendar = class(TWSCustomCalendar)
published
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override;
class procedure AdaptBounds(const AWinControl: TWinControl;
var Left, Top, Width, Height: integer; var SuppressMove: boolean); override;
class function GetDateTime(const ACalendar: TCustomCalendar): TDateTime; override;
class function HitTest(const ACalendar: TCustomCalendar; const APoint: TPoint): TCalendarPart; override;
class procedure SetDateTime(const ACalendar: TCustomCalendar; const ADateTime: TDateTime); override;
class procedure SetDisplaySettings(const ACalendar: TCustomCalendar; const ASettings: TDisplaySettings); override;
end;
implementation
uses
WinCEInt, InterfaceBase;
{ TWinCEWSCustomCalendar }
class function TWinCEWSCustomCalendar.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND;
var
Params: TCreateWindowExParams;
init : TINITCOMMONCONTROLSEX;
begin
init.dwSize := Sizeof(TINITCOMMONCONTROLSEX);
init.dwICC := ICC_DATE_CLASSES;
{$ifdef win32}
InitCommonControlsEx(init);
{$else}
InitCommonControlsEx(@init);
{$endif}
// general initialization of Params
PrepareCreateWindow(AWinControl, AParams, Params);
// customization of Params
with Params do
begin
pClassName := 'SysMonthCal32';
WindowTitle := StrCaption;
Flags := WS_CHILD or WS_VISIBLE;
if dsShowWeekNumbers in TCustomCalendar(AWinControl).DisplaySettings then
Flags := Flags or MCS_WEEKNUMBERS;
SubClassWndProc := @WindowProc;
end;
// create window
FinishCreateWindow(AWinControl, Params, false);
Result := Params.Window;
SetClassLong(Result, GCL_STYLE, GetClassLong(Result, GCL_STYLE) or CS_DBLCLKS);
// resize to proper size
SetBounds(AWinControl, Params.Left, Params.Top, 0, 0);
end;
class procedure TWinCEWSCustomCalendar.AdaptBounds(const AWinControl: TWinControl;
var Left, Top, Width, Height: integer; var SuppressMove: boolean);
var
WinHandle: HWND;
lRect: TRect;
begin
WinHandle := AWinControl.Handle;
Windows.SendMessage(WinHandle, MCM_GETMINREQRECT, 0, LPARAM(@lRect));
Width := lRect.Right;
Height := lRect.Bottom;
end;
class function TWinCEWSCustomCalendar.GetDateTime(const ACalendar: TCustomCalendar): TDateTime;
var
ST: SystemTime;
begin
SendMessage(ACalendar.Handle, MCM_GETCURSEL, 0, LPARAM(@ST));
with ST do
Result := EncodeDate(WYear,WMonth,WDay);
end;
class function TWinCEWSCustomCalendar.HitTest(const ACalendar: TCustomCalendar;
const APoint: TPoint): TCalendarPart;
var
HitTestInfo: MCHITTESTINFO;
HitPart: DWord;
begin
Result := cpNoWhere;
if not WSCheckHandleAllocated(ACalendar, 'HitTest') then
Exit;
FillChar(HitTestInfo, SizeOf(HitTestInfo), 0);
HitTestInfo.cbSize := SizeOf(HitTestInfo);
HitTestInfo.pt := APoint;
HitPart := SendMessage(ACalendar.Handle, MCM_HITTEST, 0, LPARAM(@HitTestInfo));
case HitPart of
MCHT_CALENDARDATE,
MCHT_CALENDARDATENEXT,
MCHT_CALENDARDATEPREV: Result := cpDate;
MCHT_CALENDARWEEKNUM : Result := cpWeekNumber;
MCHT_TITLEBK: Result := cpTitle;
MCHT_TITLEMONTH: Result := cpTitleMonth;
MCHT_TITLEYEAR: Result := cpTitleYear;
MCHT_TITLEBTNNEXT,
MCHT_TITLEBTNPREV: Result := cpTitleBtn;
end;
end;
class procedure TWinCEWSCustomCalendar.SetDateTime(const ACalendar: TCustomCalendar; const ADateTime: TDateTime);
var
ST: SystemTime;
begin
DecodeDate(ADateTime, ST.WYear, ST.WMonth, ST.WDay);
SendMessage(ACalendar.Handle, MCM_SETCURSEL, 0, Windows.LParam(@ST));
end;
class procedure TWinCEWSCustomCalendar.SetDisplaySettings(const ACalendar: TCustomCalendar; const ASettings: TDisplaySettings);
var
Style: LongInt;
begin
if not WSCheckHandleAllocated(ACalendar, 'SetDisplaySettings') then
Exit;
Style := GetWindowLong(ACalendar.Handle, GWL_STYLE);
if dsShowWeekNumbers in ASettings then
Style := Style or MCS_WEEKNUMBERS
else
Style := Style and not MCS_WEEKNUMBERS;
SetWindowLong(ACalendar.Handle, GWL_STYLE, Style);
end;
end.
|
