source: cprs/branches/HealthSevak-CPRS/CPRS-Lib/ORDtTm.pas@ 1707

Last change on this file since 1707 was 1693, checked in by healthsevak, 10 years ago

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