source: cprs/branches/foia-cprs/CPRS-Lib/ORDtTm.pas@ 488

Last change on this file since 488 was 460, checked in by Kevin Toppenberg, 16 years ago

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