1 | unit ORDtTm;
|
---|
2 |
|
---|
3 | {$O-}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons,
|
---|
9 | Grids, Calendar, ExtCtrls, ORFn, ORNet, ORDtTmCal, Mask, ComCtrls, OR2006Compatibility,
|
---|
10 | ORCtrls, VAClasses;
|
---|
11 |
|
---|
12 | type
|
---|
13 | TORfrmDtTm = class(Tfrm2006Compatibility)
|
---|
14 | bvlFrame: TBevel;
|
---|
15 | lblDate: TPanel;
|
---|
16 | txtTime: TEdit;
|
---|
17 | lstHour: TListBox;
|
---|
18 | lstMinute: TListBox;
|
---|
19 | cmdOK: TButton;
|
---|
20 | cmdCancel: TButton;
|
---|
21 | calSelect: TORCalendar;
|
---|
22 | pnlPrevMonth: TPanel;
|
---|
23 | pnlNextMonth: TPanel;
|
---|
24 | imgPrevMonth: TImage;
|
---|
25 | imgNextMonth: TImage;
|
---|
26 | bvlRButton: TBevel;
|
---|
27 | cmdToday: TButton;
|
---|
28 | cmdNow: TButton;
|
---|
29 | cmdMidnight: TButton;
|
---|
30 | procedure FormCreate(Sender: TObject);
|
---|
31 | procedure calSelectChange(Sender: TObject);
|
---|
32 | procedure cmdTodayClick(Sender: TObject);
|
---|
33 | procedure txtTimeChange(Sender: TObject);
|
---|
34 | procedure lstHourClick(Sender: TObject);
|
---|
35 | procedure lstMinuteClick(Sender: TObject);
|
---|
36 | procedure cmdNowClick(Sender: TObject);
|
---|
37 | procedure cmdOKClick(Sender: TObject);
|
---|
38 | procedure cmdCancelClick(Sender: TObject);
|
---|
39 | procedure imgPrevMonthClick(Sender: TObject);
|
---|
40 | procedure imgNextMonthClick(Sender: TObject);
|
---|
41 | procedure imgPrevMonthMouseDown(Sender: TObject; Button: TMouseButton;
|
---|
42 | Shift: TShiftState; X, Y: Integer);
|
---|
43 | procedure imgNextMonthMouseDown(Sender: TObject; Button: TMouseButton;
|
---|
44 | Shift: TShiftState; X, Y: Integer);
|
---|
45 | procedure imgPrevMonthMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
46 | Shift: TShiftState; X, Y: Integer);
|
---|
47 | procedure imgNextMonthMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
48 | Shift: TShiftState; X, Y: Integer);
|
---|
49 | procedure cmdMidnightClick(Sender: TObject);
|
---|
50 | private
|
---|
51 | FFromSelf: Boolean;
|
---|
52 | FNowPressed: Boolean;
|
---|
53 | TimeIsRequired: Boolean;
|
---|
54 | protected
|
---|
55 | procedure Loaded; override;
|
---|
56 | end;
|
---|
57 |
|
---|
58 | { TORDateTimeDlg }
|
---|
59 |
|
---|
60 | TORDateTimeDlg = class(TComponent)
|
---|
61 | private
|
---|
62 | FDateTime: TDateTime;
|
---|
63 | FDateOnly: Boolean;
|
---|
64 | FRequireTime: Boolean;
|
---|
65 | FRelativeTime: string;
|
---|
66 | function GetFMDateTime: TFMDateTime;
|
---|
67 | procedure SetDateOnly(Value: Boolean);
|
---|
68 | procedure SetFMDateTime(Value: TFMDateTime);
|
---|
69 | procedure SetRequireTime(Value: Boolean);
|
---|
70 | public
|
---|
71 | constructor Create(AOwner: TComponent); override;
|
---|
72 | function Execute: Boolean;
|
---|
73 | property RelativeTime: string read FRelativeTime;
|
---|
74 | published
|
---|
75 | property FMDateTime: TFMDateTime read GetFMDateTime write SetFMDateTime;
|
---|
76 | property DateOnly: Boolean read FDateOnly write SetDateOnly;
|
---|
77 | property RequireTime: Boolean read FRequireTime write SetRequireTime;
|
---|
78 | end;
|
---|
79 |
|
---|
80 | // 508 class
|
---|
81 | TORDateButton = class (TBitBtn);
|
---|
82 |
|
---|
83 | { TORDateBox }
|
---|
84 |
|
---|
85 | TORDateEdit = class(TEdit)
|
---|
86 | protected
|
---|
87 | procedure CreateParams(var Params: TCreateParams); override;
|
---|
88 | end;
|
---|
89 |
|
---|
90 | TORDateBox = class(TORDateEdit, IVADynamicProperty, IORBlackColorModeCompatible)
|
---|
91 | private
|
---|
92 | FFMDateTime: TFMDateTime;
|
---|
93 | FDateOnly: Boolean;
|
---|
94 | FRequireTime: Boolean;
|
---|
95 | FButton: TORDateButton;
|
---|
96 | FFormat: string;
|
---|
97 | FTimeIsNow: Boolean;
|
---|
98 | FTemplateField: boolean;
|
---|
99 | FCaption: TStaticText;
|
---|
100 | FBlackColorMode: boolean;
|
---|
101 | procedure ButtonClick(Sender: TObject);
|
---|
102 | function GetFMDateTime: TFMDateTime;
|
---|
103 | function GetRelativeTime: string;
|
---|
104 | procedure SetDateOnly(Value: Boolean);
|
---|
105 | procedure SetFMDateTime(Value: TFMDateTime);
|
---|
106 | procedure SetEditRect;
|
---|
107 | procedure SetRequireTime(Value: Boolean);
|
---|
108 | procedure UpdateText;
|
---|
109 | procedure WMSize(var Message: TWMSize); message WM_SIZE;
|
---|
110 | procedure SetTemplateField(const Value: boolean);
|
---|
111 | procedure SetCaption(const Value: string);
|
---|
112 | function GetCaption(): string;
|
---|
113 | protected
|
---|
114 | procedure Change; override;
|
---|
115 | procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
---|
116 | property DateButton: TORDateButton read FButton;
|
---|
117 | public
|
---|
118 | constructor Create(AOwner: TComponent); override;
|
---|
119 | function IsValid: Boolean;
|
---|
120 | procedure Validate(var ErrMsg: string);
|
---|
121 | procedure SetBlackColorMode(Value: boolean);
|
---|
122 | function SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
123 | function GetDynamicProperty(PropertyID: integer): string;
|
---|
124 | property Format: string read FFormat write FFormat;
|
---|
125 | property RelativeTime: string read GetRelativeTime;
|
---|
126 | property TemplateField: boolean read FTemplateField write SetTemplateField;
|
---|
127 | published
|
---|
128 | property FMDateTime: TFMDateTime read GetFMDateTime write SetFMDateTime;
|
---|
129 | property DateOnly: Boolean read FDateOnly write SetDateOnly;
|
---|
130 | property RequireTime: Boolean read FRequireTime write SetRequireTime;
|
---|
131 | property Caption: string read GetCaption write SetCaption;
|
---|
132 | end;
|
---|
133 |
|
---|
134 | // 508 classes
|
---|
135 | TORDayCombo = class (TORComboBox);
|
---|
136 | TORMonthCombo = class (TORComboBox);
|
---|
137 | TORYearEdit = class(TMaskEdit)
|
---|
138 | private
|
---|
139 | FTemplateField: boolean;
|
---|
140 | procedure SetTemplateField(const Value: boolean);
|
---|
141 | protected
|
---|
142 | property TemplateField: boolean read FTemplateField write SetTemplateField;
|
---|
143 | end;
|
---|
144 |
|
---|
145 | TORYearEditClass = Class of TORYearEdit;
|
---|
146 |
|
---|
147 | TORDateCombo = class(TCustomPanel, IORBlackColorModeCompatible)
|
---|
148 | private
|
---|
149 | FYearChanging: boolean;
|
---|
150 | FMonthCombo: TORMonthCombo;
|
---|
151 | FDayCombo: TORDayCombo;
|
---|
152 | FYearEdit: TORYearEdit;
|
---|
153 | FYearUD: TUpDown;
|
---|
154 | FCalBtn: TORDateButton;
|
---|
155 | FIncludeMonth: boolean;
|
---|
156 | FIncludeDay: boolean;
|
---|
157 | FIncludeBtn: boolean;
|
---|
158 | FLongMonths: boolean;
|
---|
159 | FMonth: integer;
|
---|
160 | FDay: integer;
|
---|
161 | FYear: integer;
|
---|
162 | FCtrlsCreated: boolean;
|
---|
163 | FOnChange: TNotifyEvent;
|
---|
164 | FRebuilding: boolean;
|
---|
165 | FTemplateField: boolean;
|
---|
166 | FBlackColorMode: boolean;
|
---|
167 | FORYearEditClass: TORYearEditClass;
|
---|
168 | procedure SetIncludeBtn(const Value: boolean);
|
---|
169 | procedure SetIncludeDay(Value: boolean);
|
---|
170 | procedure SetIncludeMonth(const Value: boolean);
|
---|
171 | procedure SetLongMonths(const Value: boolean);
|
---|
172 | procedure SetDay(Value: integer);
|
---|
173 | procedure SetMonth(Value: integer);
|
---|
174 | procedure SetYear(const Value: integer);
|
---|
175 | function GetFMDate: TFMDateTime;
|
---|
176 | procedure SetFMDate(const Value: TFMDateTime);
|
---|
177 | procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
|
---|
178 | procedure SetTemplateField(const Value: boolean);
|
---|
179 | protected
|
---|
180 | procedure Rebuild; virtual;
|
---|
181 | function InitDays(GetSize: boolean): integer;
|
---|
182 | function InitMonths(GetSize: boolean): integer;
|
---|
183 | function GetYearSize: integer;
|
---|
184 | procedure DoChange;
|
---|
185 | procedure MonthChanged(Sender: TObject);
|
---|
186 | procedure DayChanged(Sender: TObject);
|
---|
187 | procedure YearChanged(Sender: TObject);
|
---|
188 | procedure BtnClicked(Sender: TObject);
|
---|
189 | procedure YearUDChange(Sender: TObject; var AllowChange: Boolean;
|
---|
190 | NewValue: Smallint; Direction: TUpDownDirection);
|
---|
191 | procedure YearKeyPress(Sender: TObject; var Key: Char);
|
---|
192 | procedure CheckDays;
|
---|
193 | procedure Loaded; override;
|
---|
194 | procedure Paint; override;
|
---|
195 | procedure Resized(Sender: TObject);
|
---|
196 | property MonthCombo: TORMonthCombo read FMonthCombo;
|
---|
197 | property DayCombo: TORDayCombo read FDayCombo;
|
---|
198 | property YearEdit: TORYearEdit read FYearEdit;
|
---|
199 | property YearUD: TUpDown read FYearUD;
|
---|
200 | property CalBtn: TORDateButton read FCalBtn;
|
---|
201 | property ORYearEditClass: TORYearEditClass read FORYearEditClass write FORYearEditClass;
|
---|
202 | public
|
---|
203 | constructor Create(AOwner: TComponent); override;
|
---|
204 | destructor Destroy; override;
|
---|
205 | function DateText: string;
|
---|
206 | procedure SetBlackColorMode(Value: boolean);
|
---|
207 | property TemplateField: boolean read FTemplateField write SetTemplateField;
|
---|
208 | property FMDate: TFMDateTime read GetFMDate write SetFMDate;
|
---|
209 | published
|
---|
210 | function Text: string;
|
---|
211 | property IncludeBtn: boolean read FIncludeBtn write SetIncludeBtn;
|
---|
212 | property IncludeDay: boolean read FIncludeDay write SetIncludeDay;
|
---|
213 | property IncludeMonth: boolean read FIncludeMonth write SetIncludeMonth;
|
---|
214 | property LongMonths: boolean read FLongMonths write SetLongMonths default FALSE;
|
---|
215 | property Month: integer read FMonth write SetMonth;
|
---|
216 | property Day: integer read FDay write SetDay;
|
---|
217 | property Year: integer read FYear write SetYear;
|
---|
218 | property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
---|
219 | property Anchors;
|
---|
220 | property Enabled;
|
---|
221 | property Font;
|
---|
222 | property ParentColor;
|
---|
223 | property ParentFont;
|
---|
224 | property TabOrder;
|
---|
225 | property TabStop;
|
---|
226 | property Visible;
|
---|
227 | end;
|
---|
228 |
|
---|
229 | function IsLeapYear(AYear: Integer): Boolean;
|
---|
230 | function DaysPerMonth(AYear, AMonth: Integer): Integer;
|
---|
231 |
|
---|
232 | procedure Register;
|
---|
233 |
|
---|
234 | implementation
|
---|
235 |
|
---|
236 | {$R *.DFM}
|
---|
237 | {$R ORDtTm}
|
---|
238 |
|
---|
239 | const
|
---|
240 | FMT_DATETIME = 'mmm d,yyyy@hh:nn';
|
---|
241 | FMT_DATEONLY = 'mmm d,yyyy';
|
---|
242 | (*
|
---|
243 | HOURS_AMPM: array[0..23] of string[3] =
|
---|
244 | ('12a',' 1',' 2',' 3',' 4',' 5',' 6',' 7',' 8',' 9','10 ','11 ',
|
---|
245 | '12p',' 1',' 2',' 3',' 4',' 5',' 6',' 7',' 8',' 9','10 ','11 ');
|
---|
246 | HOURS_MIL: array[0..23] of string[2] =
|
---|
247 | ('00','01','02','03','04','05','06','07','08','09','10','11',
|
---|
248 | '12','13','14','15','16','17','18','19','20','21','22','23');
|
---|
249 | *)
|
---|
250 | AdjVertSize = 8;
|
---|
251 | FontHeightText = 'BEFHILMSTVWXZfgjmpqtyk';
|
---|
252 |
|
---|
253 | var
|
---|
254 | uServerToday: TFMDateTime;
|
---|
255 |
|
---|
256 | { Server-dependent functions ---------------------------------------------------------------- }
|
---|
257 |
|
---|
258 | function ActiveBroker: Boolean;
|
---|
259 | begin
|
---|
260 | Result := False;
|
---|
261 | if (RPCBrokerV <> nil) and RPCBrokerV.Connected then Result := True;
|
---|
262 | end;
|
---|
263 |
|
---|
264 | function ServerFMNow: TFMDateTime;
|
---|
265 | begin
|
---|
266 | if ActiveBroker
|
---|
267 | then Result := StrToFloat(sCallV('ORWU DT', ['NOW']))
|
---|
268 | else Result := DateTimeToFMDateTime(Now);
|
---|
269 | end;
|
---|
270 |
|
---|
271 | function ServerNow: TDateTime;
|
---|
272 | begin
|
---|
273 | if ActiveBroker
|
---|
274 | then Result := FMDateTimeToDateTime(ServerFMNow)
|
---|
275 | else Result := Now;
|
---|
276 | end;
|
---|
277 |
|
---|
278 | function ServerToday: TDateTime;
|
---|
279 | begin
|
---|
280 | if uServerToday = 0 then uServerToday := Int(ServerFMNow);
|
---|
281 | Result := FMDateTimeToDateTime(uServerToday);
|
---|
282 | end;
|
---|
283 |
|
---|
284 | (*
|
---|
285 | function ServerFMToday: TFMDateTime; // never referenced in this unit
|
---|
286 | begin
|
---|
287 | if uServerToday = 0 then uServerToday := Int(ServerFMNow);
|
---|
288 | Result := uServerToday;
|
---|
289 | end;
|
---|
290 | *)
|
---|
291 |
|
---|
292 | function ServerParseFMDate(const AString: string): TFMDateTime;
|
---|
293 | begin
|
---|
294 | if ActiveBroker
|
---|
295 | then Result := StrToFloat(sCallV('ORWU DT', [AString, 'TSX']))
|
---|
296 | else Result := 0;
|
---|
297 | end;
|
---|
298 |
|
---|
299 | function RelativeDateTime(ADateTime: TDateTime): string;
|
---|
300 | var
|
---|
301 | Offset: Integer;
|
---|
302 | h,n,s,l: Word;
|
---|
303 | ATime: string;
|
---|
304 | begin
|
---|
305 | Offset := Trunc(Int(ADateTime) - Int(ServerToday));
|
---|
306 | if Offset < 0 then Result := 'T' + IntToStr(Offset)
|
---|
307 | else if Offset = 0 then Result := 'T'
|
---|
308 | else Result := 'T+' + IntToStr(Offset);
|
---|
309 | DecodeTime(ADateTime, h, n, s, l);
|
---|
310 | ATime := Format('@%.2d:%.2d', [h, n]);
|
---|
311 | if ATime <> '@00:00' then Result := Result + ATime;
|
---|
312 | end;
|
---|
313 |
|
---|
314 | procedure LoadEllipsis(bitmap: TBitMap; BlackColorMode: boolean);
|
---|
315 | var
|
---|
316 | ResName: string;
|
---|
317 | begin
|
---|
318 | if BlackColorMode then
|
---|
319 | ResName := 'BLACK_BMP_ELLIPSIS'
|
---|
320 | else
|
---|
321 | ResName := 'BMP_ELLIPSIS';
|
---|
322 | bitmap.LoadFromResourceName(hInstance, ResName);
|
---|
323 | end;
|
---|
324 |
|
---|
325 | { TfrmORDtTm -------------------------------------------------------------------------------- }
|
---|
326 |
|
---|
327 | procedure TORfrmDtTm.FormCreate(Sender: TObject);
|
---|
328 | begin
|
---|
329 | ResizeAnchoredFormToFont(self);
|
---|
330 | //FormStyle := fsStayOnTop;
|
---|
331 | lstHour.TopIndex := 6;
|
---|
332 | FFromSelf := False;
|
---|
333 | calSelectChange(Self);
|
---|
334 | end;
|
---|
335 |
|
---|
336 | procedure TORfrmDtTm.calSelectChange(Sender: TObject);
|
---|
337 | begin
|
---|
338 | lblDate.Caption := FormatDateTime('mmmm d, yyyy', calSelect.CalendarDate);
|
---|
339 | FNowPressed := False;
|
---|
340 | end;
|
---|
341 |
|
---|
342 | procedure TORfrmDtTm.imgPrevMonthMouseDown(Sender: TObject;
|
---|
343 | Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
---|
344 | begin
|
---|
345 | pnlPrevMonth.BevelOuter := bvLowered;
|
---|
346 | end;
|
---|
347 |
|
---|
348 | procedure TORfrmDtTm.imgNextMonthMouseDown(Sender: TObject;
|
---|
349 | Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
---|
350 | begin
|
---|
351 | pnlNextMonth.BevelOuter := bvLowered;
|
---|
352 | end;
|
---|
353 |
|
---|
354 | procedure TORfrmDtTm.imgPrevMonthClick(Sender: TObject);
|
---|
355 | begin
|
---|
356 | calSelect.PrevMonth;
|
---|
357 | end;
|
---|
358 |
|
---|
359 | procedure TORfrmDtTm.imgNextMonthClick(Sender: TObject);
|
---|
360 | begin
|
---|
361 | calSelect.NextMonth;
|
---|
362 | end;
|
---|
363 |
|
---|
364 | procedure TORfrmDtTm.imgPrevMonthMouseUp(Sender: TObject;
|
---|
365 | Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
---|
366 | begin
|
---|
367 | pnlPrevMonth.BevelOuter := bvRaised;
|
---|
368 | end;
|
---|
369 |
|
---|
370 | procedure TORfrmDtTm.imgNextMonthMouseUp(Sender: TObject;
|
---|
371 | Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
---|
372 | begin
|
---|
373 | pnlNextMonth.BevelOuter := bvRaised;
|
---|
374 | end;
|
---|
375 |
|
---|
376 | procedure TORfrmDtTm.cmdTodayClick(Sender: TObject);
|
---|
377 | begin
|
---|
378 | calSelect.CalendarDate := ServerToday;
|
---|
379 | lstHour.ItemIndex := -1;
|
---|
380 | lstMinute.ItemIndex := -1;
|
---|
381 | txtTime.Text := '';
|
---|
382 | end;
|
---|
383 |
|
---|
384 | procedure TORfrmDtTm.txtTimeChange(Sender: TObject);
|
---|
385 | begin
|
---|
386 | if not FFromSelf then
|
---|
387 | begin
|
---|
388 | lstHour.ItemIndex := -1;
|
---|
389 | lstMinute.ItemIndex := -1;
|
---|
390 | end;
|
---|
391 | FNowPressed := False;
|
---|
392 | end;
|
---|
393 |
|
---|
394 | procedure TORfrmDtTm.lstHourClick(Sender: TObject);
|
---|
395 | begin
|
---|
396 | if lstHour.ItemIndex = 0 then lstMinute.Items[0] := ':01 --' else lstMinute.Items[0] := ':00 --'; //<------ NEW CODE
|
---|
397 | if lstMinute.ItemIndex < 0 then lstMinute.ItemIndex := 0;
|
---|
398 | lstMinuteClick(Self);
|
---|
399 | end;
|
---|
400 |
|
---|
401 | procedure TORfrmDtTm.lstMinuteClick(Sender: TObject);
|
---|
402 | var
|
---|
403 | AnHour, AMinute: Integer;
|
---|
404 | // AmPm: string;
|
---|
405 | begin
|
---|
406 | if lstHour.ItemIndex < 0 then Exit;
|
---|
407 |
|
---|
408 | // if ampm time -
|
---|
409 | //case lstHour.ItemIndex of
|
---|
410 | // 0: AnHour := 12;
|
---|
411 | //1..12: AnHour := lstHour.ItemIndex;
|
---|
412 | //else AnHour := lstHour.ItemIndex - 12;
|
---|
413 | //end;
|
---|
414 | //if lstHour.ItemIndex > 11 then AmPm := 'PM' else AmPm := 'AM';
|
---|
415 |
|
---|
416 | // if military time
|
---|
417 | AnHour := lstHour.ItemIndex;
|
---|
418 |
|
---|
419 | AMinute := lstMinute.ItemIndex * 5;
|
---|
420 | if (AnHour = 0) and (AMinute = 0) then AMinute := 1; //<-------------- NEW CODE
|
---|
421 | FFromSelf := True;
|
---|
422 | // if ampm time -
|
---|
423 | //txtTime.Text := Format('%d:%.2d ' + AmPm, [AnHour, AMinute]);
|
---|
424 |
|
---|
425 | // if military time
|
---|
426 | txtTime.Text := Format('%.2d:%.2d ', [AnHour, AMinute]);
|
---|
427 |
|
---|
428 | FFromSelf := False;
|
---|
429 | end;
|
---|
430 |
|
---|
431 | procedure TORfrmDtTm.cmdNowClick(Sender: TObject);
|
---|
432 | begin
|
---|
433 | calSelect.CalendarDate := ServerToday;
|
---|
434 | //txtTime.Text := FormatDateTime('h:nn ampm', ServerNow); // if ampm time
|
---|
435 | txtTime.Text := FormatDateTime('hh:nn', ServerNow); // if ampm time
|
---|
436 | FNowPressed := True;
|
---|
437 | end;
|
---|
438 |
|
---|
439 | procedure TORfrmDtTm.cmdMidnightClick(Sender: TObject);
|
---|
440 | begin
|
---|
441 | //txtTime.Text := '11:59 PM'; // if ampm time
|
---|
442 | txtTime.Text := '23:59'; // if military time
|
---|
443 | end;
|
---|
444 |
|
---|
445 | procedure TORfrmDtTm.cmdOKClick(Sender: TObject);
|
---|
446 | var
|
---|
447 | x: string;
|
---|
448 | begin
|
---|
449 | if TimeIsRequired and (Length(txtTime.Text) = 0) then
|
---|
450 | begin
|
---|
451 | InfoBox('An entry for time is required.', 'Missing Time', MB_OK);
|
---|
452 | Exit;
|
---|
453 | end;
|
---|
454 | if Length(txtTime.Text) > 0 then
|
---|
455 | begin
|
---|
456 | x := Trim(txtTime.Text);
|
---|
457 | //if (x='00:00') or (x='0:00') or (x='00:00:00') or (x='0:00:00') then x := '00:00:01';
|
---|
458 | if (x='00:00') or (x='0:00') or (x='00:00:00') or (x='0:00:00') then x := '00:01'; //<------- CHANGED CODE
|
---|
459 | StrToTime(x);
|
---|
460 | txtTime.Text := x;
|
---|
461 | end;
|
---|
462 | ModalResult := mrOK;
|
---|
463 | end;
|
---|
464 |
|
---|
465 | procedure TORfrmDtTm.cmdCancelClick(Sender: TObject);
|
---|
466 | begin
|
---|
467 | ModalResult := mrCancel;
|
---|
468 | end;
|
---|
469 |
|
---|
470 | procedure TORfrmDtTm.Loaded;
|
---|
471 | begin
|
---|
472 | inherited Loaded;
|
---|
473 | UpdateColorsFor508Compliance(Self);
|
---|
474 | end;
|
---|
475 |
|
---|
476 | { TORDateTimeDlg }
|
---|
477 |
|
---|
478 | constructor TORDateTimeDlg.Create(AOwner: TComponent);
|
---|
479 | begin
|
---|
480 | inherited Create(AOwner);
|
---|
481 | if not (csDesigning in ComponentState)
|
---|
482 | then FDateTime := ServerToday
|
---|
483 | else FDateTime := SysUtils.Date;
|
---|
484 | end;
|
---|
485 |
|
---|
486 | function TORDateTimeDlg.Execute: Boolean;
|
---|
487 | const
|
---|
488 | HORZ_SPACING = 8;
|
---|
489 | var
|
---|
490 | frmDtTm: TORfrmDtTm;
|
---|
491 | begin
|
---|
492 | frmDtTm := TORfrmDtTm.Create(Application);
|
---|
493 | try
|
---|
494 | with frmDtTm do
|
---|
495 | begin
|
---|
496 | calSelect.CalendarDate := Int(FDateTime);
|
---|
497 | if Frac(FDateTime) > 0
|
---|
498 | //then txtTime.Text := FormatDateTime('h:nn ampm', FDateTime); // if ampm time
|
---|
499 | then txtTime.Text := FormatDateTime('hh:nn', FDateTime); // if military time
|
---|
500 | if RequireTime then TimeIsRequired := True;
|
---|
501 | if DateOnly then
|
---|
502 | begin
|
---|
503 | txtTime.Visible := False;
|
---|
504 | lstHour.Visible := False;
|
---|
505 | lstMinute.Visible := False;
|
---|
506 | cmdNow.Visible := False;
|
---|
507 | cmdMidnight.Visible := False;
|
---|
508 | bvlFrame.Width := bvlFrame.Width - txtTime.Width - HORZ_SPACING;
|
---|
509 | cmdOK.Left := cmdOK.Left - txtTime.Width - HORZ_SPACING;
|
---|
510 | cmdCancel.Left := cmdOK.Left;
|
---|
511 | ClientWidth := ClientWidth - txtTime.Width - HORZ_SPACING;
|
---|
512 | end;
|
---|
513 | Result := (ShowModal = IDOK);
|
---|
514 | if Result then
|
---|
515 | begin
|
---|
516 | FDateTime := Int(calSelect.CalendarDate);
|
---|
517 | if Length(txtTime.Text) > 0 then FDateTime := FDateTime + StrToTime(txtTime.Text);
|
---|
518 | if FNowPressed
|
---|
519 | then FRelativeTime := 'NOW'
|
---|
520 | else FRelativeTime := RelativeDateTime(FDateTime);
|
---|
521 | end;
|
---|
522 | end;
|
---|
523 | finally
|
---|
524 | frmDtTm.Free;
|
---|
525 | end;
|
---|
526 | end;
|
---|
527 |
|
---|
528 | function TORDateTimeDlg.GetFMDateTime: TFMDateTime;
|
---|
529 | begin
|
---|
530 | Result := DateTimeToFMDateTime(FDateTime);
|
---|
531 | end;
|
---|
532 |
|
---|
533 | procedure TORDateTimeDlg.SetDateOnly(Value: Boolean);
|
---|
534 | begin
|
---|
535 | FDateOnly := Value;
|
---|
536 | if FDateOnly then
|
---|
537 | begin
|
---|
538 | FRequireTime := False;
|
---|
539 | FDateTime := Int(FDateTime);
|
---|
540 | end;
|
---|
541 | end;
|
---|
542 |
|
---|
543 | procedure TORDateTimeDlg.SetFMDateTime(Value: TFMDateTime);
|
---|
544 | begin
|
---|
545 | if Value > 0 then FDateTime := FMDateTimeToDateTime(Value);
|
---|
546 | end;
|
---|
547 |
|
---|
548 | procedure TORDateTimeDlg.SetRequireTime(Value: Boolean);
|
---|
549 | begin
|
---|
550 | FRequireTime := Value;
|
---|
551 | if FRequireTime then FDateOnly := False;
|
---|
552 | end;
|
---|
553 |
|
---|
554 | { TORDateEdit ----------------------------------------------------------------------------- }
|
---|
555 |
|
---|
556 | procedure TORDateEdit.CreateParams(var Params: TCreateParams);
|
---|
557 | { sets a one line edit box to multiline style so the editing rectangle can be changed }
|
---|
558 | begin
|
---|
559 | inherited CreateParams(Params);
|
---|
560 | Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN;
|
---|
561 | end;
|
---|
562 |
|
---|
563 |
|
---|
564 | { TORDateBox -------------------------------------------------------------------------------- }
|
---|
565 |
|
---|
566 | constructor TORDateBox.Create(AOwner: TComponent);
|
---|
567 | begin
|
---|
568 | inherited Create(AOwner);
|
---|
569 | FButton := TORDateButton.Create(Self);
|
---|
570 | FButton.Parent := Self;
|
---|
571 | FButton.Width := 18;
|
---|
572 | FButton.Height := 17;
|
---|
573 | FButton.OnClick := ButtonClick;
|
---|
574 | FButton.TabStop := False;
|
---|
575 | FBlackColorMode := False;
|
---|
576 | LoadEllipsis(FButton.Glyph, FALSE);
|
---|
577 | FButton.Visible := True;
|
---|
578 | FFormat := FMT_DATETIME;
|
---|
579 | end;
|
---|
580 |
|
---|
581 | procedure TORDateBox.WMSize(var Message: TWMSize);
|
---|
582 | var
|
---|
583 | ofs: integer;
|
---|
584 |
|
---|
585 | begin
|
---|
586 | inherited;
|
---|
587 | if assigned(FButton) then
|
---|
588 | begin
|
---|
589 | if BorderStyle = bsNone then
|
---|
590 | ofs := 0
|
---|
591 | else
|
---|
592 | ofs := 4;
|
---|
593 | FButton.SetBounds(Width - FButton.Width - ofs, 0, FButton.Width, Height - ofs);
|
---|
594 | end;
|
---|
595 | SetEditRect;
|
---|
596 | end;
|
---|
597 |
|
---|
598 | procedure TORDateBox.SetTemplateField(const Value: boolean);
|
---|
599 | var
|
---|
600 | Y: integer;
|
---|
601 |
|
---|
602 | begin
|
---|
603 | if(FTemplateField <> Value) then
|
---|
604 | begin
|
---|
605 | FTemplateField := Value;
|
---|
606 | Y := TextHeightByFont(Font.Handle, FontHeightText);
|
---|
607 | if Value then
|
---|
608 | begin
|
---|
609 | FButton.Width := Y+2;
|
---|
610 | Height := Y;
|
---|
611 | BorderStyle := bsNone;
|
---|
612 | end
|
---|
613 | else
|
---|
614 | begin
|
---|
615 | FButton.Width := 18;
|
---|
616 | Height := y + AdjVertSize;
|
---|
617 | BorderStyle := bsSingle;
|
---|
618 | end;
|
---|
619 | end;
|
---|
620 | end;
|
---|
621 |
|
---|
622 | function TORDateBox.SupportsDynamicProperty(PropertyID: integer): boolean;
|
---|
623 | begin
|
---|
624 | Result := (PropertyID = DynaPropAccesibilityCaption);
|
---|
625 | end;
|
---|
626 |
|
---|
627 | procedure TORDateBox.ButtonClick(Sender: TObject);
|
---|
628 | var
|
---|
629 | DateDialog: TORDateTimeDlg;
|
---|
630 | ParsedDate: TFMDateTime;
|
---|
631 | begin
|
---|
632 | DateDialog := TORDateTimeDlg.Create(Application);
|
---|
633 | if Length(Text) > 0 then
|
---|
634 | begin
|
---|
635 | ParsedDate := ServerParseFMDate(Text);
|
---|
636 | if ParsedDate > -1 then FFMDateTime := ParsedDate else FFMDateTime := 0;
|
---|
637 | end;
|
---|
638 | DateDialog.DateOnly := FDateOnly;
|
---|
639 | DateDialog.FMDateTime := FFMDateTime;
|
---|
640 | DateDialog.RequireTime := FRequireTime;
|
---|
641 | if DateDialog.Execute then
|
---|
642 | begin
|
---|
643 | FFMDateTime := DateDialog.FMDateTime;
|
---|
644 | UpdateText;
|
---|
645 | FTimeIsNow := DateDialog.RelativeTime = 'NOW';
|
---|
646 | end;
|
---|
647 | DateDialog.Free;
|
---|
648 | if Visible and Enabled then //Some events may hide the component
|
---|
649 | SetFocus;
|
---|
650 | end;
|
---|
651 |
|
---|
652 | procedure TORDateBox.Change;
|
---|
653 | begin
|
---|
654 | inherited Change;
|
---|
655 | FTimeIsNow := False;
|
---|
656 | end;
|
---|
657 |
|
---|
658 | procedure TORDateBox.KeyDown(var Key: Word; Shift: TShiftState);
|
---|
659 | begin
|
---|
660 | inherited KeyDown(Key, Shift);
|
---|
661 | if (Key = VK_RETURN) then begin
|
---|
662 | FButton.Click;
|
---|
663 | Key := 0;
|
---|
664 | end;
|
---|
665 | end;
|
---|
666 |
|
---|
667 | function TORDateBox.GetFMDateTime: TFMDateTime;
|
---|
668 | begin
|
---|
669 | Result := 0;
|
---|
670 | if Length(Text) > 0 then Result := ServerParseFMDate(Text);
|
---|
671 | FFMDateTime := Result;
|
---|
672 | end;
|
---|
673 |
|
---|
674 | function TORDateBox.GetRelativeTime: string;
|
---|
675 | begin
|
---|
676 | Result := '';
|
---|
677 | if FTimeIsNow then Result := 'NOW'
|
---|
678 | else if UpperCase(Text) = 'NOW' then Result := 'NOW'
|
---|
679 | else if Length(Text) > 0 then
|
---|
680 | begin
|
---|
681 | FFMDateTime := ServerParseFMDate(Text);
|
---|
682 | if FFMDateTime > 0 then Result := RelativeDateTime(FMDateTimeToDateTime(FFMDateTime));
|
---|
683 | end;
|
---|
684 | end;
|
---|
685 |
|
---|
686 | procedure TORDateBox.SetDateOnly(Value: Boolean);
|
---|
687 | begin
|
---|
688 | FDateOnly := Value;
|
---|
689 | if FDateOnly then
|
---|
690 | begin
|
---|
691 | FRequireTime := False;
|
---|
692 | FFMDateTime := Int(FFMDateTime);
|
---|
693 | if FFormat = FMT_DATETIME then FFormat := FMT_DATEONLY;
|
---|
694 | end;
|
---|
695 | UpdateText;
|
---|
696 | end;
|
---|
697 |
|
---|
698 | procedure TORDateBox.SetFMDateTime(Value: TFMDateTime);
|
---|
699 | begin
|
---|
700 | FFMDateTime := Value;
|
---|
701 | UpdateText;
|
---|
702 | end;
|
---|
703 |
|
---|
704 | procedure TORDateBox.SetRequireTime(Value: Boolean);
|
---|
705 | begin
|
---|
706 | FRequireTime := Value;
|
---|
707 | if FRequireTime then
|
---|
708 | begin
|
---|
709 | if FFormat = FMT_DATEONLY then FFormat := FMT_DATETIME;
|
---|
710 | SetDateOnly(False);
|
---|
711 | end;
|
---|
712 | end;
|
---|
713 |
|
---|
714 | procedure TORDateBox.SetEditRect;
|
---|
715 | { change the edit rectangle to not hide the calendar button - taken from SPIN.PAS sample }
|
---|
716 | var
|
---|
717 | Loc: TRect;
|
---|
718 | begin
|
---|
719 | SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
|
---|
720 | Loc.Bottom := ClientHeight + 1; // +1 is workaround for windows paint bug
|
---|
721 | Loc.Right := FButton.Left - 2;
|
---|
722 | Loc.Top := 0;
|
---|
723 | Loc.Left := 0;
|
---|
724 | SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
|
---|
725 | end;
|
---|
726 |
|
---|
727 | procedure TORDateBox.UpdateText;
|
---|
728 | begin
|
---|
729 | if FFMDateTime > 0 then
|
---|
730 | begin
|
---|
731 | if (FFormat =FMT_DATETIME) and (Frac(FFMDateTime) = 0)
|
---|
732 | then Text := FormatFMDateTime(FMT_DATEONLY, FFMDateTime)
|
---|
733 | else Text := FormatFMDateTime(FFormat, FFMDateTime);
|
---|
734 | end;
|
---|
735 | end;
|
---|
736 |
|
---|
737 | procedure TORDateBox.Validate(var ErrMsg: string);
|
---|
738 | begin
|
---|
739 | ErrMsg := '';
|
---|
740 | if Length(Text) > 0 then
|
---|
741 | begin
|
---|
742 | FFMDateTime := ServerParseFMDate(Text);
|
---|
743 | if FFMDateTime <= 0 then Errmsg := 'Invalid Date/Time';
|
---|
744 | if FRequireTime and (Frac(FFMDateTime) = 0) then ErrMsg := 'Time Required';
|
---|
745 | if FDateOnly and (Frac(FFMDateTime) > 0) then ErrMsg := 'Time not Required';
|
---|
746 | end;
|
---|
747 | end;
|
---|
748 |
|
---|
749 | function TORDateBox.IsValid: Boolean;
|
---|
750 | var
|
---|
751 | x: string;
|
---|
752 | begin
|
---|
753 | Validate(x);
|
---|
754 | if Length(x) = 0 then Result := True else Result := False;
|
---|
755 | if Length(Text) = 0 then Result := False;
|
---|
756 | end;
|
---|
757 |
|
---|
758 | procedure TORDateBox.SetBlackColorMode(Value: boolean);
|
---|
759 | begin
|
---|
760 | if FBlackColorMode <> Value then
|
---|
761 | begin
|
---|
762 | FBlackColorMode := Value;
|
---|
763 | LoadEllipsis(FButton.Glyph, FBlackColorMode);
|
---|
764 | end;
|
---|
765 | end;
|
---|
766 |
|
---|
767 | procedure TORDateBox.SetCaption(const Value: string);
|
---|
768 | begin
|
---|
769 | if not Assigned(FCaption) then begin
|
---|
770 | FCaption := TStaticText.Create(self);
|
---|
771 | FCaption.AutoSize := False;
|
---|
772 | FCaption.Height := 0;
|
---|
773 | FCaption.Width := 0;
|
---|
774 | FCaption.Visible := True;
|
---|
775 | FCaption.Parent := Parent;
|
---|
776 | FCaption.BringtoFront;
|
---|
777 | end;
|
---|
778 | FCaption.Caption := Value;
|
---|
779 | end;
|
---|
780 |
|
---|
781 | function TORDateBox.GetCaption(): string;
|
---|
782 | begin
|
---|
783 | result := FCaption.Caption;
|
---|
784 | end;
|
---|
785 |
|
---|
786 | function TORDateBox.GetDynamicProperty(PropertyID: integer): string;
|
---|
787 | begin
|
---|
788 | if PropertyID = DynaPropAccesibilityCaption then
|
---|
789 | Result := GetCaption
|
---|
790 | else
|
---|
791 | Result := '';
|
---|
792 | end;
|
---|
793 |
|
---|
794 | function IsLeapYear(AYear: Integer): Boolean;
|
---|
795 | begin
|
---|
796 | Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
|
---|
797 | end;
|
---|
798 |
|
---|
799 | function DaysPerMonth(AYear, AMonth: Integer): Integer;
|
---|
800 | const
|
---|
801 | DaysInMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
|
---|
802 |
|
---|
803 | begin
|
---|
804 | if(AYear < 1) or (AMonth < 1) then
|
---|
805 | Result := 0
|
---|
806 | else
|
---|
807 | begin
|
---|
808 | Result := DaysInMonth[AMonth];
|
---|
809 | if (AMonth = 2) and IsLeapYear(AYear) then Inc(Result); { leap-year Feb is special }
|
---|
810 | end;
|
---|
811 | end;
|
---|
812 |
|
---|
813 | { TORDateCombo ------------------------------------------------------------------------- }
|
---|
814 |
|
---|
815 | const
|
---|
816 | ComboBoxAdjSize = 24;
|
---|
817 | EditAdjHorzSize = 8;
|
---|
818 | DateComboCtrlGap = 2;
|
---|
819 | FirstYear = 1800;
|
---|
820 | LastYear = 2200;
|
---|
821 |
|
---|
822 | { TORDateComboEdit }
|
---|
823 |
|
---|
824 | procedure TORYearEdit.SetTemplateField(const Value: boolean);
|
---|
825 | begin
|
---|
826 | if(FTemplateField <> Value) then
|
---|
827 | begin
|
---|
828 | FTemplateField := Value;
|
---|
829 | if Value then
|
---|
830 | BorderStyle := bsNone
|
---|
831 | else
|
---|
832 | BorderStyle := bsSingle;
|
---|
833 | end;
|
---|
834 | end;
|
---|
835 |
|
---|
836 | { TORDateCombo }
|
---|
837 |
|
---|
838 | constructor TORDateCombo.Create(AOwner: TComponent);
|
---|
839 | begin
|
---|
840 | inherited;
|
---|
841 | ControlStyle := ControlStyle - [csSetCaption, csAcceptsControls];
|
---|
842 | BevelOuter := bvNone;
|
---|
843 | FIncludeMonth := TRUE;
|
---|
844 | FIncludeDay := TRUE;
|
---|
845 | FIncludeBtn := TRUE;
|
---|
846 | OnResize := Resized;
|
---|
847 | FORYearEditClass := TORYearEdit;
|
---|
848 | end;
|
---|
849 |
|
---|
850 | destructor TORDateCombo.Destroy;
|
---|
851 | begin
|
---|
852 | KillObj(@FMonthCombo);
|
---|
853 | KillObj(@FDayCombo);
|
---|
854 | KillObj(@FYearEdit);
|
---|
855 | KillObj(@FYearUD);
|
---|
856 | KillObj(@FCalBtn);
|
---|
857 | inherited;
|
---|
858 | end;
|
---|
859 |
|
---|
860 | function TORDateCombo.GetYearSize: integer;
|
---|
861 | begin
|
---|
862 | Result := TextWidthByFont(Font.Handle, '8888') + EditAdjHorzSize;
|
---|
863 | end;
|
---|
864 |
|
---|
865 | function TORDateCombo.InitDays(GetSize: boolean): integer;
|
---|
866 | var
|
---|
867 | dy: integer;
|
---|
868 |
|
---|
869 | begin
|
---|
870 | Result := 0;
|
---|
871 | if(assigned(FDayCombo)) then
|
---|
872 | begin
|
---|
873 | dy := DaysPerMonth(FYear, FMonth) + 1;
|
---|
874 | while (FDayCombo.Items.Count < dy) do
|
---|
875 | begin
|
---|
876 | if(FDayCombo.Items.Count = 0) then
|
---|
877 | FDayCombo.Items.Add(' ')
|
---|
878 | else
|
---|
879 | FDayCombo.Items.Add(inttostr(FDayCombo.Items.Count));
|
---|
880 | end;
|
---|
881 | while (FDayCombo.Items.Count > dy) do
|
---|
882 | FDayCombo.Items.Delete(FDayCombo.Items.Count-1);
|
---|
883 | if(GetSize) then
|
---|
884 | Result := TextWidthByFont(Font.Handle, '88') + ComboBoxAdjSize;
|
---|
885 | if(FDay > (dy-1)) then
|
---|
886 | SetDay(dy-1);
|
---|
887 | end;
|
---|
888 | end;
|
---|
889 |
|
---|
890 | function TORDateCombo.InitMonths(GetSize: boolean): integer;
|
---|
891 | var
|
---|
892 | i, Size: integer;
|
---|
893 |
|
---|
894 | begin
|
---|
895 | Result := 0;
|
---|
896 | if(assigned(FMonthCombo)) then
|
---|
897 | begin
|
---|
898 | FMonthCombo.Items.Clear;
|
---|
899 | FMonthCombo.Items.Add(' ');
|
---|
900 | for i := 1 to 12 do
|
---|
901 | begin
|
---|
902 | if FLongMonths then
|
---|
903 | FMonthCombo.Items.Add(LongMonthNames[i])
|
---|
904 | else
|
---|
905 | FMonthCombo.Items.Add(ShortMonthNames[i]);
|
---|
906 | if(GetSize) then
|
---|
907 | begin
|
---|
908 | Size := TextWidthByFont(Font.Handle, FMonthCombo.Items[i]);
|
---|
909 | if(Result < Size) then
|
---|
910 | Result := Size;
|
---|
911 | end;
|
---|
912 | end;
|
---|
913 | if(GetSize) then
|
---|
914 | inc(Result, ComboBoxAdjSize);
|
---|
915 | end;
|
---|
916 | end;
|
---|
917 |
|
---|
918 | procedure TORDateCombo.Rebuild;
|
---|
919 | var
|
---|
920 | Wide, X, Y: integer;
|
---|
921 |
|
---|
922 | begin
|
---|
923 | if(not FRebuilding) then
|
---|
924 | begin
|
---|
925 | FRebuilding := TRUE;
|
---|
926 | try
|
---|
927 | ControlStyle := ControlStyle + [csAcceptsControls];
|
---|
928 | try
|
---|
929 | Y := TextHeightByFont(Font.Handle, FontHeightText);
|
---|
930 | if not FTemplateField then
|
---|
931 | inc(Y,AdjVertSize);
|
---|
932 | X := 0;
|
---|
933 | if(FIncludeMonth) then
|
---|
934 | begin
|
---|
935 | if(not assigned(FMonthCombo)) then
|
---|
936 | begin
|
---|
937 | FMonthCombo := TORMonthCombo.Create(Self);
|
---|
938 | FMonthCombo.Parent := Self;
|
---|
939 | FMonthCombo.Top := 0;
|
---|
940 | FMonthCombo.Left := 0;
|
---|
941 | FMonthCombo.Style := orcsDropDown;
|
---|
942 | FMonthCombo.DropDownCount := 13;
|
---|
943 | FMonthCombo.ListItemsOnly := True;
|
---|
944 | FMonthCombo.OnChange := MonthChanged;
|
---|
945 | end;
|
---|
946 | FMonthCombo.Font := Font;
|
---|
947 | FMonthCombo.TemplateField := FTemplateField;
|
---|
948 | Wide := InitMonths(TRUE);
|
---|
949 | FMonthCombo.Width := Wide;
|
---|
950 | FMonthCombo.Height := Y;
|
---|
951 | FMonthCombo.ItemIndex := FMonth;
|
---|
952 | inc(X, Wide + DateComboCtrlGap);
|
---|
953 |
|
---|
954 | if(FIncludeDay) then
|
---|
955 | begin
|
---|
956 | if(not assigned(FDayCombo)) then
|
---|
957 | begin
|
---|
958 | FDayCombo := TORDayCombo.Create(Self);
|
---|
959 | FDayCombo.Parent := Self;
|
---|
960 | FDayCombo.Top := 0;
|
---|
961 | FDayCombo.Style := orcsDropDown;
|
---|
962 | FDayCombo.ListItemsOnly := True;
|
---|
963 | FDayCombo.OnChange := DayChanged;
|
---|
964 | FDayCombo.DropDownCount := 11;
|
---|
965 | end;
|
---|
966 | FDayCombo.Font := Font;
|
---|
967 | FDayCombo.TemplateField := FTemplateField;
|
---|
968 | Wide := InitDays(TRUE);
|
---|
969 | FDayCombo.Width := Wide;
|
---|
970 | FDayCombo.Height := Y;
|
---|
971 | FDayCombo.Left := X;
|
---|
972 | FDayCombo.ItemIndex := FDay;
|
---|
973 | inc(X, Wide + DateComboCtrlGap);
|
---|
974 | end
|
---|
975 | else
|
---|
976 | KillObj(@FDayCombo);
|
---|
977 | end
|
---|
978 | else
|
---|
979 | begin
|
---|
980 | KillObj(@FDayCombo);
|
---|
981 | KillObj(@FMonthCombo);
|
---|
982 | end;
|
---|
983 | if(not assigned(FYearEdit)) then
|
---|
984 | begin
|
---|
985 | FYearEdit := FORYearEditClass.Create(Self);
|
---|
986 | FYearEdit.Parent := Self;
|
---|
987 | FYearEdit.Top := 0;
|
---|
988 | FYearEdit.EditMask := '9999;1; ';
|
---|
989 | FYearEdit.OnKeyPress := YearKeyPress;
|
---|
990 | FYearEdit.OnChange := YearChanged;
|
---|
991 | end;
|
---|
992 | FYearEdit.Font := Font;
|
---|
993 | FYearEdit.TemplateField := FTemplateField;
|
---|
994 | Wide := GetYearSize;
|
---|
995 | FYearEdit.Width := Wide;
|
---|
996 | FYearEdit.Height := Y;
|
---|
997 | FYearEdit.Left := X;
|
---|
998 | inc(X, Wide);
|
---|
999 | if(not assigned(FYearUD)) then
|
---|
1000 | begin
|
---|
1001 | FYearUD := TUpDown.Create(Self);
|
---|
1002 | FYearUD.Parent := Self;
|
---|
1003 | FYearUD.Thousands := FALSE;
|
---|
1004 | FYearUD.Min := FirstYear-1;
|
---|
1005 | FYearUD.Max := LastYear;
|
---|
1006 | FYearUD.OnChangingEx := YearUDChange;
|
---|
1007 | end;
|
---|
1008 | FYearEdit.TabOrder := 0;
|
---|
1009 | FYearUD.Top := 0;
|
---|
1010 | FYearUD.Left := X;
|
---|
1011 | FYearUD.Height := Y;
|
---|
1012 | FYearUD.Position := FYear;
|
---|
1013 | inc(X, FYearUD.Width + DateComboCtrlGap);
|
---|
1014 | if(FIncludeBtn) then
|
---|
1015 | begin
|
---|
1016 | if(not assigned(FCalBtn)) then
|
---|
1017 | begin
|
---|
1018 | FCalBtn := TORDateButton.Create(Self);
|
---|
1019 | FCalBtn.TabStop := FALSE;
|
---|
1020 | FCalBtn.Parent := Self;
|
---|
1021 | FCalBtn.Top := 0;
|
---|
1022 | LoadEllipsis(FCalBtn.Glyph, FBlackColorMode);
|
---|
1023 | FCalBtn.OnClick := BtnClicked;
|
---|
1024 | end;
|
---|
1025 | Wide := FYearEdit.Height;
|
---|
1026 | if(Wide > Y) then Wide := Y;
|
---|
1027 | FCalBtn.Width := Wide;
|
---|
1028 | FCalBtn.Height := Wide;
|
---|
1029 | FCalBtn.Left := X;
|
---|
1030 | inc(X, Wide + DateComboCtrlGap);
|
---|
1031 | end
|
---|
1032 | else
|
---|
1033 | KillObj(@FCalBtn);
|
---|
1034 | Self.Width := X - DateComboCtrlGap;
|
---|
1035 | Self.Height := Y;
|
---|
1036 | CheckDays;
|
---|
1037 | FCtrlsCreated := TRUE;
|
---|
1038 | DoChange;
|
---|
1039 | finally
|
---|
1040 | ControlStyle := ControlStyle - [csAcceptsControls];
|
---|
1041 | end;
|
---|
1042 | finally
|
---|
1043 | FRebuilding := FALSE;
|
---|
1044 | end;
|
---|
1045 | end;
|
---|
1046 | end;
|
---|
1047 |
|
---|
1048 | procedure TORDateCombo.SetBlackColorMode(Value: boolean);
|
---|
1049 | begin
|
---|
1050 | if FBlackColorMode <> Value then
|
---|
1051 | begin
|
---|
1052 | FBlackColorMode := Value;
|
---|
1053 | if assigned(FCalBtn) then
|
---|
1054 | LoadEllipsis(FCalBtn.Glyph, FBlackColorMode);
|
---|
1055 | end;
|
---|
1056 | end;
|
---|
1057 |
|
---|
1058 | procedure TORDateCombo.SetDay(Value: integer);
|
---|
1059 | begin
|
---|
1060 | if(not assigned(FDayCombo)) and (not (csLoading in ComponentState)) then
|
---|
1061 | Value := 0;
|
---|
1062 | if(Value > DaysPerMonth(FYear, FMonth)) then
|
---|
1063 | Value := 0;
|
---|
1064 | if(FDay <> Value) then
|
---|
1065 | begin
|
---|
1066 | FDay := Value;
|
---|
1067 | if(assigned(FDayCombo)) then
|
---|
1068 | begin
|
---|
1069 | if(FDayCombo.Items.Count <= FDay) then
|
---|
1070 | InitDays(FALSE);
|
---|
1071 | FDayCombo.ItemIndex := FDay;
|
---|
1072 | end;
|
---|
1073 | DoChange;
|
---|
1074 | end;
|
---|
1075 | end;
|
---|
1076 |
|
---|
1077 | procedure TORDateCombo.SetIncludeBtn(const Value: boolean);
|
---|
1078 | begin
|
---|
1079 | if(FIncludeBtn <> Value) then
|
---|
1080 | begin
|
---|
1081 | FIncludeBtn := Value;
|
---|
1082 | Rebuild;
|
---|
1083 | end;
|
---|
1084 | end;
|
---|
1085 |
|
---|
1086 | procedure TORDateCombo.SetIncludeDay(Value: boolean);
|
---|
1087 | begin
|
---|
1088 | if(Value) and (not FIncludeMonth) then
|
---|
1089 | Value := FALSE;
|
---|
1090 | if(FIncludeDay <> Value) then
|
---|
1091 | begin
|
---|
1092 | FIncludeDay := Value;
|
---|
1093 | if(not Value) then FDay := 0;
|
---|
1094 | Rebuild;
|
---|
1095 | end;
|
---|
1096 | end;
|
---|
1097 |
|
---|
1098 | procedure TORDateCombo.SetIncludeMonth(const Value: boolean);
|
---|
1099 | begin
|
---|
1100 | if(FIncludeMonth <> Value) then
|
---|
1101 | begin
|
---|
1102 | FIncludeMonth := Value;
|
---|
1103 | if(not Value) then
|
---|
1104 | begin
|
---|
1105 | FIncludeDay := FALSE;
|
---|
1106 | FMonth := 0;
|
---|
1107 | FDay := 0;
|
---|
1108 | end;
|
---|
1109 | Rebuild;
|
---|
1110 | end;
|
---|
1111 | end;
|
---|
1112 |
|
---|
1113 | procedure TORDateCombo.SetMonth(Value: integer);
|
---|
1114 | begin
|
---|
1115 | if(not assigned(FMonthCombo)) and (not (csLoading in ComponentState)) then
|
---|
1116 | Value := 0;
|
---|
1117 | if(Value <0) or (Value > 12) then
|
---|
1118 | Value := 0;
|
---|
1119 | if(FMonth <> Value) then
|
---|
1120 | begin
|
---|
1121 | FMonth := Value;
|
---|
1122 | if(assigned(FMonthCombo)) then
|
---|
1123 | FMonthCombo.ItemIndex := FMonth;
|
---|
1124 | CheckDays;
|
---|
1125 | DoChange;
|
---|
1126 | end;
|
---|
1127 | end;
|
---|
1128 |
|
---|
1129 | procedure TORDateCombo.SetLongMonths(const Value: boolean);
|
---|
1130 | begin
|
---|
1131 | if(FLongMonths <> Value) then
|
---|
1132 | begin
|
---|
1133 | FLongMonths := Value;
|
---|
1134 | Rebuild;
|
---|
1135 | end;
|
---|
1136 | end;
|
---|
1137 |
|
---|
1138 | procedure TORDateCombo.SetYear(const Value: integer);
|
---|
1139 | begin
|
---|
1140 | if(FYear <> Value) then
|
---|
1141 | begin
|
---|
1142 | FYear := Value;
|
---|
1143 | if(FYear < FirstYear) or (FYear > LastYear) then
|
---|
1144 | FYear := 0;
|
---|
1145 | if(not FYearChanging) and (assigned(FYearEdit)) and (assigned(FYearUD)) then
|
---|
1146 | begin
|
---|
1147 | FYearChanging := TRUE;
|
---|
1148 | try
|
---|
1149 | if(FYear = 0) then
|
---|
1150 | begin
|
---|
1151 | FYearEdit.Text := ' ';
|
---|
1152 | FYearUD.Position := FirstYear-1
|
---|
1153 | end
|
---|
1154 | else
|
---|
1155 | begin
|
---|
1156 | FYearEdit.Text := IntToStr(FYear);
|
---|
1157 | FYearUD.Position := FYear;
|
---|
1158 | end;
|
---|
1159 | finally
|
---|
1160 | FYearChanging := FALSE;
|
---|
1161 | end;
|
---|
1162 | end;
|
---|
1163 | if(FMonth = 2) then
|
---|
1164 | InitDays(FALSE);
|
---|
1165 | CheckDays;
|
---|
1166 | DoChange;
|
---|
1167 | end;
|
---|
1168 | end;
|
---|
1169 |
|
---|
1170 | procedure TORDateCombo.DayChanged(Sender: TObject);
|
---|
1171 | begin
|
---|
1172 | FDay := FDayCombo.ItemIndex;
|
---|
1173 | if(FDay < 0) then
|
---|
1174 | FDay := 0;
|
---|
1175 | CheckDays;
|
---|
1176 | DoChange;
|
---|
1177 | end;
|
---|
1178 |
|
---|
1179 | procedure TORDateCombo.MonthChanged(Sender: TObject);
|
---|
1180 | begin
|
---|
1181 | FMonth := FMonthCombo.ItemIndex;
|
---|
1182 | if(FMonth < 0) then
|
---|
1183 | FMonth := 0;
|
---|
1184 | InitDays(FALSE);
|
---|
1185 | CheckDays;
|
---|
1186 | DoChange;
|
---|
1187 | end;
|
---|
1188 |
|
---|
1189 | procedure TORDateCombo.YearChanged(Sender: TObject);
|
---|
1190 | begin
|
---|
1191 | if FYearChanging then exit;
|
---|
1192 | FYearChanging := TRUE;
|
---|
1193 | try
|
---|
1194 | FYear := StrToIntDef(FYearEdit.Text, 0);
|
---|
1195 | if(FYear < FirstYear) or (FYear > LastYear) then
|
---|
1196 | FYear := 0;
|
---|
1197 | if(FYear = 0) then
|
---|
1198 | FYearUD.Position := FirstYear-1
|
---|
1199 | else
|
---|
1200 | FYearUD.Position := FYear;
|
---|
1201 | if(FMonth = 2) then
|
---|
1202 | InitDays(FALSE);
|
---|
1203 | CheckDays;
|
---|
1204 | DoChange;
|
---|
1205 | finally
|
---|
1206 | FYearChanging := FALSE;
|
---|
1207 | end;
|
---|
1208 | end;
|
---|
1209 |
|
---|
1210 | procedure TORDateCombo.CheckDays;
|
---|
1211 | var
|
---|
1212 | MaxDays: integer;
|
---|
1213 |
|
---|
1214 | begin
|
---|
1215 | if(FIncludeMonth and assigned(FMonthCombo)) then
|
---|
1216 | begin
|
---|
1217 | FMonthCombo.Enabled := (FYear > 0);
|
---|
1218 | if (FYear = 0) then
|
---|
1219 | SetMonth(0);
|
---|
1220 | if(FIncludeMonth and FIncludeDay and assigned(FDayCombo)) then
|
---|
1221 | begin
|
---|
1222 | FDayCombo.Enabled := ((FYear > 0) and (FMonth > 0));
|
---|
1223 | MaxDays := DaysPerMonth(FYear, FMonth);
|
---|
1224 | if(FDay > MaxDays) then
|
---|
1225 | SetDay(MaxDays);
|
---|
1226 | end;
|
---|
1227 | end;
|
---|
1228 | end;
|
---|
1229 |
|
---|
1230 | procedure TORDateCombo.Loaded;
|
---|
1231 | begin
|
---|
1232 | inherited;
|
---|
1233 | if(not FCtrlsCreated) then
|
---|
1234 | Rebuild;
|
---|
1235 | end;
|
---|
1236 |
|
---|
1237 | procedure TORDateCombo.Paint;
|
---|
1238 | begin
|
---|
1239 | if(not FCtrlsCreated) then
|
---|
1240 | Rebuild;
|
---|
1241 | inherited;
|
---|
1242 | end;
|
---|
1243 |
|
---|
1244 | procedure TORDateCombo.BtnClicked(Sender: TObject);
|
---|
1245 | var
|
---|
1246 | mm, dd, yy: integer;
|
---|
1247 | m, d, y: word;
|
---|
1248 | DateDialog: TORDateTimeDlg;
|
---|
1249 |
|
---|
1250 | begin
|
---|
1251 | DateDialog := TORDateTimeDlg.Create(self);
|
---|
1252 | try
|
---|
1253 | mm := FMonth;
|
---|
1254 | dd := FDay;
|
---|
1255 | yy := FYear;
|
---|
1256 | DecodeDate(Now, y, m, d);
|
---|
1257 | if(FYear = 0) then FYear := y;
|
---|
1258 | if(FYear = y) then
|
---|
1259 | begin
|
---|
1260 | if((FMonth = 0) or (FMonth = m)) and (FDay = 0) then
|
---|
1261 | begin
|
---|
1262 | FMonth := m;
|
---|
1263 | FDay := d;
|
---|
1264 | end;
|
---|
1265 | end;
|
---|
1266 | if(FMonth = 0) then
|
---|
1267 | FMonth := 1;
|
---|
1268 | if(FDay = 0) then
|
---|
1269 | FDay := 1;
|
---|
1270 | DateDialog.FMDateTime := GetFMDate;
|
---|
1271 | DateDialog.DateOnly := TRUE;
|
---|
1272 | DateDialog.RequireTime := FALSE;
|
---|
1273 | if DateDialog.Execute then
|
---|
1274 | begin
|
---|
1275 | FYear := 0;
|
---|
1276 | FMonth := 0;
|
---|
1277 | FDay := 0;
|
---|
1278 | SetFMDate(DateDialog.FMDateTime);
|
---|
1279 | end
|
---|
1280 | else
|
---|
1281 | begin
|
---|
1282 | SetYear(yy);
|
---|
1283 | SetMonth(mm);
|
---|
1284 | SetDay(dd);
|
---|
1285 | end;
|
---|
1286 | finally
|
---|
1287 | DateDialog.Free;
|
---|
1288 | end;
|
---|
1289 | end;
|
---|
1290 |
|
---|
1291 | procedure TORDateCombo.YearUDChange(Sender: TObject; var AllowChange: Boolean;
|
---|
1292 | NewValue: Smallint; Direction: TUpDownDirection);
|
---|
1293 | var
|
---|
1294 | y, m, d: word;
|
---|
1295 |
|
---|
1296 | begin
|
---|
1297 | if FYearChanging then exit;
|
---|
1298 | FYearChanging := TRUE;
|
---|
1299 | try
|
---|
1300 | if FYearUD.Position = (FirstYear-1) then
|
---|
1301 | begin
|
---|
1302 | DecodeDate(Now, y, m, d);
|
---|
1303 | FYear := y;
|
---|
1304 | FYearUD.Position := y;
|
---|
1305 | AllowChange := FALSE;
|
---|
1306 | end
|
---|
1307 | else
|
---|
1308 | FYear := NewValue;
|
---|
1309 | if(FYear < FirstYear) or (FYear > LastYear) then
|
---|
1310 | FYear := 0;
|
---|
1311 | if(FYear = 0) then
|
---|
1312 | FYearEdit.Text := ' '
|
---|
1313 | else
|
---|
1314 | FYearEdit.Text := IntToStr(FYear);
|
---|
1315 | if(FMonth = 2) then
|
---|
1316 | InitDays(FALSE);
|
---|
1317 | CheckDays;
|
---|
1318 | DoChange;
|
---|
1319 | finally
|
---|
1320 | FYearChanging := FALSE;
|
---|
1321 | end;
|
---|
1322 | end;
|
---|
1323 |
|
---|
1324 | procedure TORDateCombo.YearKeyPress(Sender: TObject; var Key: Char);
|
---|
1325 | begin
|
---|
1326 | if(Key in ['0'..'9']) and (FYearEdit.Text = ' ') then
|
---|
1327 | begin
|
---|
1328 | FYearEdit.Text := Key + ' ';
|
---|
1329 | Key := #0;
|
---|
1330 | FYearEdit.SelStart := 1;
|
---|
1331 | FYearEdit.SelText := '';
|
---|
1332 | end;
|
---|
1333 | end;
|
---|
1334 |
|
---|
1335 | function TORDateCombo.GetFMDate: TFMDateTime;
|
---|
1336 | begin
|
---|
1337 | if(FYear < FirstYear) then
|
---|
1338 | Result := 0
|
---|
1339 | else
|
---|
1340 | Result := ((FYear - 1700) * 10000 + FMonth * 100 + FDay);
|
---|
1341 | end;
|
---|
1342 |
|
---|
1343 | procedure TORDateCombo.SetFMDate(const Value: TFMDateTime);
|
---|
1344 | var
|
---|
1345 | ival, mo, dy: integer;
|
---|
1346 |
|
---|
1347 | begin
|
---|
1348 | if(Value = 0) then
|
---|
1349 | begin
|
---|
1350 | SetYear(0);
|
---|
1351 | SetMonth(0);
|
---|
1352 | end
|
---|
1353 | else
|
---|
1354 | begin
|
---|
1355 | ival := trunc(Value);
|
---|
1356 | if(length(inttostr(ival)) <> 7) then
|
---|
1357 | exit;
|
---|
1358 | dy := (ival mod 100);
|
---|
1359 | ival := ival div 100;
|
---|
1360 | mo := ival mod 100;
|
---|
1361 | ival := ival div 100;
|
---|
1362 | SetYear(ival + 1700);
|
---|
1363 | SetMonth(mo);
|
---|
1364 | InitDays(FALSE);
|
---|
1365 | SetDay(dy);
|
---|
1366 | end;
|
---|
1367 | end;
|
---|
1368 |
|
---|
1369 | function TORDateCombo.DateText: string;
|
---|
1370 | begin
|
---|
1371 | Result := '';
|
---|
1372 | if(FYear > 0) then
|
---|
1373 | begin
|
---|
1374 | if(FMonth > 0) then
|
---|
1375 | begin
|
---|
1376 | if FLongMonths then
|
---|
1377 | Result := LongMonthNames[FMonth]
|
---|
1378 | else
|
---|
1379 | Result := ShortMonthNames[FMonth];
|
---|
1380 | if(FDay > 0) then
|
---|
1381 | Result := Result + ' ' + IntToStr(FDay);
|
---|
1382 | Result := Result + ', ';
|
---|
1383 | end;
|
---|
1384 | Result := Result + IntToStr(FYear);
|
---|
1385 | end;
|
---|
1386 | end;
|
---|
1387 |
|
---|
1388 | procedure TORDateCombo.DoChange;
|
---|
1389 | begin
|
---|
1390 | if assigned(FOnChange) then
|
---|
1391 | FOnChange(Self);
|
---|
1392 | end;
|
---|
1393 |
|
---|
1394 | procedure TORDateCombo.Resized(Sender: TObject);
|
---|
1395 | begin
|
---|
1396 | Rebuild;
|
---|
1397 | end;
|
---|
1398 |
|
---|
1399 | procedure TORDateCombo.CMFontChanged(var Message: TMessage);
|
---|
1400 | begin
|
---|
1401 | inherited;
|
---|
1402 | Rebuild;
|
---|
1403 | end;
|
---|
1404 |
|
---|
1405 | function TORDateCombo.Text: string;
|
---|
1406 | var
|
---|
1407 | tmp, fmt, m: string;
|
---|
1408 |
|
---|
1409 | begin
|
---|
1410 | Result := '';
|
---|
1411 | tmp := FloatToStr(FMDate);
|
---|
1412 | if(tmp <> '') and (tmp <> '0') and (length(Tmp) >= 7) then
|
---|
1413 | begin
|
---|
1414 | if FLongMonths then
|
---|
1415 | m := 'mmmm'
|
---|
1416 | else
|
---|
1417 | m := 'mmm';
|
---|
1418 | if(copy(tmp,4,4) = '0000') then
|
---|
1419 | fmt := 'yyyy'
|
---|
1420 | else
|
---|
1421 | if(copy(tmp,6,2) = '00') then
|
---|
1422 | fmt := m + ', YYYY'
|
---|
1423 | else
|
---|
1424 | fmt := m + ' D, YYYY';
|
---|
1425 | Result := FormatFMDateTimeStr(fmt, tmp)
|
---|
1426 | end;
|
---|
1427 | end;
|
---|
1428 |
|
---|
1429 |
|
---|
1430 | procedure Register;
|
---|
1431 | { used by Delphi to put components on the Palette }
|
---|
1432 | begin
|
---|
1433 | RegisterComponents('CPRS', [TORDateTimeDlg, TORDateBox, TORDateCombo]);
|
---|
1434 | end;
|
---|
1435 |
|
---|
1436 | procedure TORDateCombo.SetTemplateField(const Value: boolean);
|
---|
1437 | begin
|
---|
1438 | if FTemplateField <> Value then
|
---|
1439 | begin
|
---|
1440 | FTemplateField := Value;
|
---|
1441 | Rebuild;
|
---|
1442 | end;
|
---|
1443 | end;
|
---|
1444 |
|
---|
1445 | initialization
|
---|
1446 | uServerToday := 0;
|
---|
1447 |
|
---|
1448 | end.
|
---|