27. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 8/3/2017 10:10:45 AM Central Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.

27.1 Files compared

# Location File Last Modified
1 V31A.zip\V31A\448\OR_30_448V7_SRC\OR ORDtTm.pas Thu Mar 2 16:33:28 2017 UTC
2 V31A.zip\V31A\448\OR_30_448V7_SRC\OR ORDtTm.pas Thu Aug 3 13:30:09 2017 UTC

27.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 2 2930
Changed 1 2
Inserted 0 0
Removed 0 0

27.3 Comparison options

Whitespace
Character case Differences in character case are significant
Line endings Differences in line endings (CR and LF characters) are ignored
CR/LF characters Not shown in the comparison detail

27.4 Active regular expressions

No regular expressions were active.

27.5 Comparison detail

  1   unit ORDtT m;
  2  
  3   {$O-}
  4  
  5   interface
  6  
  7   uses
  8     Windows,  Messages,  SysUtils,  Classes,  Graphics,  Controls,  Forms, Dia logs, StdC trls, Butt ons,
  9     Grids, C alendar, E xtCtrls, O RFn, ORNet , ORDtTmCa l, Mask, C omCtrls, O R2006Compa tibility,
  10     ORCtrls,  VAClasses ;
  11  
  12   type
  13     TORfrmDt Tm = class (Tfrm2006C ompatibili ty)
  14       bvlFra me: TBevel ;
  15       lblDat e: TPanel;
  16       txtTim e: TEdit;
  17       lstHou r: TListBo x;
  18       lstMin ute: TList Box;
  19       cmdOK:  TButton;
  20       cmdCan cel: TButt on;
  21       calSel ect: TORCa lendar;
  22       pnlPre vMonth: TP anel;
  23       pnlNex tMonth: TP anel;
  24       imgPre vMonth: TI mage;
  25       imgNex tMonth: TI mage;
  26       bvlRBu tton: TBev el;
  27       cmdTod ay: TButto n;
  28       cmdNow : TButton;
  29       cmdMid night: TBu tton;
  30       proced ure FormCr eate(Sende r: TObject );
  31       proced ure calSel ectChange( Sender: TO bject);
  32       proced ure cmdTod ayClick(Se nder: TObj ect);
  33       proced ure txtTim eChange(Se nder: TObj ect);
  34       proced ure lstHou rClick(Sen der: TObje ct);
  35       proced ure lstMin uteClick(S ender: TOb ject);
  36       proced ure cmdNow Click(Send er: TObjec t);
  37       proced ure cmdOKC lick(Sende r: TObject );
  38       proced ure cmdCan celClick(S ender: TOb ject);
  39       proced ure imgPre vMonthClic k(Sender:  TObject);
  40       proced ure imgNex tMonthClic k(Sender:  TObject);
  41       proced ure imgPre vMonthMous eDown(Send er: TObjec t; Button:  TMouseBut ton;
  42         Shif t: TShiftS tate; X, Y : Integer) ;
  43       proced ure imgNex tMonthMous eDown(Send er: TObjec t; Button:  TMouseBut ton;
  44         Shif t: TShiftS tate; X, Y : Integer) ;
  45       proced ure imgPre vMonthMous eUp(Sender : TObject;  Button: T MouseButto n;
  46         Shif t: TShiftS tate; X, Y : Integer) ;
  47       proced ure imgNex tMonthMous eUp(Sender : TObject;  Button: T MouseButto n;
  48         Shif t: TShiftS tate; X, Y : Integer) ;
  49       proced ure cmdMid nightClick (Sender: T Object);
  50     private
  51       FFromS elf: Boole an;
  52       FNowPr essed:  Bo olean;
  53       TimeIs Required:  Boolean;
  54     protecte d
  55       proced ure Loaded ; override ;
  56     end;
  57  
  58     { TORDat eTimeDlg }
  59  
  60     TORDateT imeDlg = c lass(TComp onent)
  61     private
  62       FDateT ime:     T DateTime;
  63       FDateO nly:     B oolean;
  64       FRequi reTime:  B oolean;
  65       FRelat iveTime: s tring;
  66       functi on GetFMDa teTime: TF MDateTime;
  67       proced ure SetDat eOnly(Valu e: Boolean );
  68       proced ure SetFMD ateTime(Va lue: TFMDa teTime);
  69       proced ure SetReq uireTime(V alue: Bool ean);
  70     public
  71       constr uctor Crea te(AOwner:  TComponen t); overri de;
  72       functi on Execute : Boolean;
  73       proper ty Relativ eTime: str ing     re ad FRelati veTime;
  74     publishe d
  75       proper ty FMDateT ime:  TFMD ateTime re ad GetFMDa teTime   w rite SetFM DateTime;
  76       proper ty DateOnl y:    Bool ean     re ad FDateOn ly       w rite SetDa teOnly;
  77       proper ty Require Time: Bool ean     re ad FRequir eTime    w rite SetRe quireTime;
  78     end;
  79  
  80     // 508 c lass
  81     TORDateB utton = cl ass (TBitB tn);
  82  
  83     { TORDat eBox }
  84  
  85     TORDateE dit = clas s(TEdit)
  86     protecte d
  87       proced ure Create Params(var  Params: T CreatePara ms); overr ide;
  88     end;
  89  
  90     TORDateB ox = class (TORDateEd it, IVADyn amicProper ty, IORBla ckColorMod eCompatibl e)
  91     private
  92       FFMDat eTime: TFM DateTime;
  93       FDateO nly: Boole an;
  94       FRequi reTime: Bo olean;
  95       FButto n: TORDate Button;
  96       FForma t: string;
  97       FTimeI sNow: Bool ean;
  98       FTempl ateField:  boolean;
  99       FCapti on: TStati cText;
  100       FBlack ColorMode:  boolean;
  101       FOnDat eDialogClo sed : TNot ifyEvent;
  102       proced ure Button Click(Send er: TObjec t);
  103       functi on GetFMDa teTime: TF MDateTime;
  104       functi on GetRela tiveTime:  string;
  105       proced ure SetDat eOnly(Valu e: Boolean );
  106       proced ure SetFMD ateTime(Va lue: TFMDa teTime);
  107       proced ure SetEdi tRect;
  108       proced ure SetReq uireTime(V alue: Bool ean);
  109       proced ure Update Text;
  110       proced ure WMSize (var Messa ge: TWMSiz e); messag e WM_SIZE;
  111       proced ure SetTem plateField (const Val ue: boolea n);
  112       proced ure SetCap tion(const  Value: st ring);
  113       functi on  GetCap tion(): st ring;
  114     protecte d
  115       proced ure Change ; override ;
  116       proced ure KeyDow n(var Key:  Word; Shi ft: TShift State); ov erride;
  117       proper ty DateBut ton: TORDa teButton r ead FButto n;
  118       proced ure SetEna bled(Value : Boolean) ; override ; //wat v2 8  when di sabling TO RDateBox,  button sti ll appears  active, t his addres ses that
  119     public
  120       constr uctor Crea te(AOwner:  TComponen t); overri de;
  121       functi on IsValid : Boolean;
  122       proced ure Valida te(var Err Msg: strin g);
  123       proced ure SetBla ckColorMod e(Value: b oolean);
  124       functi on Support sDynamicPr operty(Pro pertyID: i nteger): b oolean;
  125       functi on GetDyna micPropert y(Property ID: intege r): string ;
  126       proper ty Format:  string re ad FFormat  write FFo rmat;
  127       proper ty Relativ eTime: str ing     re ad GetRela tiveTime;
  128       proper ty Templat eField: bo olean read  FTemplate Field writ e SetTempl ateField;
  129     publishe d
  130       proper ty FMDateT ime:  TFMD ateTime re ad GetFMDa teTime  wr ite SetFMD ateTime;
  131       proper ty DateOnl y:    Bool ean     re ad FDateOn ly    writ e SetDateO nly;
  132       proper ty Require Time: Bool ean     re ad FRequir eTime writ e SetRequi reTime;
  133       proper ty Caption : string r ead GetCap tion write  SetCaptio n;
  134       proper ty OnDateD ialogClose d: TNotify Event read  FOnDateDi alogClosed  write FOn DateDialog Closed;
  135     end;
  136  
  137     // 508 c lasses
  138     TORDayCo mbo = clas s (TORComb oBox);
  139     TORMonth Combo = cl ass (TORCo mboBox);
  140     TORYearE dit = clas s(TMaskEdi t)
  141     private
  142       FTempl ateField:  boolean;
  143       proced ure SetTem plateField (const Val ue: boolea n);
  144     protecte d
  145       proper ty Templat eField: bo olean read  FTemplate Field writ e SetTempl ateField;
  146     end;
  147  
  148     TORYearE ditClass =  Class of  TORYearEdi t;
  149  
  150     TORDateC ombo = cla ss(TCustom Panel, IOR BlackColor ModeCompat ible)
  151     private
  152       FYearC hanging: b oolean;
  153       FMonth Combo: TOR MonthCombo ;
  154       FDayCo mbo: TORDa yCombo;
  155       FYearE dit: TORYe arEdit;
  156       FYearU D: TUpDown ;
  157       FCalBt n: TORDate Button;
  158       FInclu deMonth: b oolean;
  159       FInclu deDay: boo lean;
  160       FInclu deBtn: boo lean;
  161       FLongM onths: boo lean;
  162       FMonth : integer;
  163       FDay:  integer;
  164       FYear:  integer;
  165       FCtrls Created: b oolean;
  166       FOnCha nge: TNoti fyEvent;
  167       FRebui lding: boo lean;
  168       FTempl ateField:  boolean;
  169       FBlack ColorMode:  boolean;
  170       FORYea rEditClass : TORYearE ditClass;
  171       proced ure SetInc ludeBtn(co nst Value:  boolean);
  172       proced ure SetInc ludeDay(Va lue: boole an);
  173       proced ure SetInc ludeMonth( const Valu e: boolean );
  174       proced ure SetLon gMonths(co nst Value:  boolean);
  175       proced ure SetDay (Value: in teger);
  176       proced ure SetMon th(Value:  integer);
  177       proced ure SetYea r(const Va lue: integ er);
  178       functi on GetFMDa te: TFMDat eTime;
  179       proced ure SetFMD ate(const  Value: TFM DateTime);
  180       proced ure CMFont Changed(va r Message:  TMessage) ; message  CM_FONTCHA NGED;
  181       proced ure SetTem plateField (const Val ue: boolea n);
  182     protecte d
  183       proced ure Rebuil d; virtual ;
  184       functi on InitDay s(GetSize:  boolean):  integer;
  185       functi on InitMon ths(GetSiz e: boolean ): integer ;
  186       functi on GetYear Size: inte ger;
  187       proced ure DoChan ge;
  188       proced ure MonthC hanged(Sen der: TObje ct);
  189       proced ure DayCha nged(Sende r: TObject );
  190       proced ure YearCh anged(Send er: TObjec t);
  191       proced ure BtnCli cked(Sende r: TObject );
  192       proced ure YearUD Change(Sen der: TObje ct; var Al lowChange:  Boolean;
  193   // 2FA                              NewValu e: Smallin t; Directi on: TUpDow nDirection );
  194                                          NewV alue: Inte ger; Direc tion: TUpD ownDirecti on);
  195       proced ure YearKe yPress(Sen der: TObje ct; var Ke y: Char);
  196       proced ure CheckD ays;
  197       proced ure Loaded ; override ;
  198       proced ure Paint;  override;
  199       proced ure Resize d(Sender:  TObject);
  200       proper ty MonthCo mbo: TORMo nthCombo r ead FMonth Combo;
  201       proper ty DayComb o: TORDayC ombo read  FDayCombo;
  202       proper ty YearEdi t: TORYear Edit read  FYearEdit;
  203       proper ty YearUD:  TUpDown r ead FYearU D;
  204       proper ty CalBtn:  TORDateBu tton read  FCalBtn;
  205       proper ty ORYearE ditClass:  TORYearEdi tClass rea d FORYearE ditClass w rite FORYe arEditClas s;
  206     public
  207       constr uctor Crea te(AOwner:  TComponen t); overri de;
  208       destru ctor Destr oy; overri de;
  209       functi on DateTex t: string;
  210       proced ure SetBla ckColorMod e(Value: b oolean);
  211       proper ty Templat eField: bo olean read  FTemplate Field writ e SetTempl ateField;
  212       proper ty FMDate:  TFMDateTi me read Ge tFMDate wr ite SetFMD ate;
  213     publishe d
  214       functi on Text: s tring;
  215       proper ty Include Btn: boole an read FI ncludeBtn  write SetI ncludeBtn;
  216       proper ty Include Day: boole an read FI ncludeDay  write SetI ncludeDay;
  217       proper ty Include Month: boo lean read  FIncludeMo nth write  SetInclude Month;
  218       proper ty LongMon ths: boole an read FL ongMonths  write SetL ongMonths  default FA LSE;
  219       proper ty Month:  integer re ad FMonth  write SetM onth;
  220       proper ty Day: in teger read  FDay writ e SetDay;
  221       proper ty Year: i nteger rea d FYear wr ite SetYea r;
  222       proper ty OnChang e: TNotify Event read  FOnChange  write FOn Change;
  223       proper ty Anchors ;
  224       proper ty Enabled ;
  225       proper ty Font;
  226       proper ty ParentC olor;
  227       proper ty ParentF ont;
  228       proper ty TabOrde r;
  229       proper ty TabStop ;
  230       proper ty Visible ;
  231     end;
  232  
  233   function I sLeapYear( AYear: Int eger): Boo lean;
  234   function D aysPerMont h(AYear, A Month: Int eger): Int eger;
  235  
  236   procedure  Register;
  237  
  238   implementa tion
  239  
  240   {$R *.DFM}
  241   {$R ORDtTm }
  242  
  243   const
  244     FMT_DATE TIME = 'mm m d,yyyy@h h:nn';
  245     FMT_DATE ONLY = 'mm m d,yyyy';
  246     (*
  247     HOURS_AM PM: array[ 0..23] of  string[3]  =
  248       ('12a' ,'  1','   2','  3','   4','  5' ,'  6','   7','  8','   9','10 ' ,'11 ',
  249        '12p' ,'  1','   2','  3','   4','  5' ,'  6','   7','  8','   9','10 ' ,'11 ');
  250     HOURS_MI L:  array[ 0..23] of  string[2]  =
  251       ('00', '01','02', '03','04', '05','06', '07','08', '09','10', '11',
  252        '12', '13','14', '15','16', '17','18', '19','20', '21','22', '23');
  253     *)
  254     AdjVertS ize = 8;
  255     FontHeig htText = ' BEFHILMSTV WXZfgjmpqt yk';
  256  
  257   var
  258     uServerT oday: TFMD ateTime;
  259  
  260   { Server-d ependent f unctions - ---------- ---------- ---------- ---------- ---------- ---------- --- }
  261  
  262   function A ctiveBroke r: Boolean ;
  263   begin
  264     Result : = False;
  265     if (RPCB rokerV <>  nil) and R PCBrokerV. Connected  then Resul t := True;
  266   end;
  267  
  268   function S erverFMNow : TFMDateT ime;
  269   begin
  270     if Activ eBroker
  271       then R esult := S trToFloat( sCallV('OR WU DT', [' NOW']))
  272       else R esult := D ateTimeToF MDateTime( Now);
  273   end;
  274  
  275   function S erverNow:  TDateTime;
  276   begin
  277     if Activ eBroker
  278       then R esult := F MDateTimeT oDateTime( ServerFMNo w)
  279       else R esult := N ow;
  280   end;
  281  
  282   function S erverToday : TDateTim e;
  283   begin
  284     if uServ erToday =  0 then uSe rverToday  := Int(Ser verFMNow);
  285     Result : = FMDateTi meToDateTi me(uServer Today);
  286   end;
  287  
  288   (*
  289   function S erverFMTod ay: TFMDat eTime;     // never r eferenced  in this un it
  290   begin
  291     if uServ erToday =  0 then uSe rverToday  := Int(Ser verFMNow);
  292     Result : = uServerT oday;
  293   end;
  294   *)
  295  
  296   function S erverParse FMDate(con st AString : string):  TFMDateTi me;
  297   begin
  298     if Activ eBroker
  299       then R esult := S trToFloat( sCallV('OR WU DT', [A String, 'T SX']))
  300       else R esult := 0 ;
  301   end;
  302  
  303   function R elativeDat eTime(ADat eTime: TDa teTime): s tring;
  304   var
  305     Offset:  Integer;
  306     h,n,s,l:  Word;
  307     ATime: s tring;
  308   begin
  309     Offset : = Trunc(In t(ADateTim e) - Int(S erverToday ));
  310     if Offse t < 0 then  Result :=  'T' + Int ToStr(Offs et)
  311     else if  Offset = 0  then Resu lt := 'T'
  312     else Res ult := 'T+ ' + IntToS tr(Offset) ;
  313     DecodeTi me(ADateTi me, h, n,  s, l);
  314     ATime :=  Format('@ %.2d:%.2d' , [h, n]);
  315     if ATime  <> '@00:0 0' then Re sult := Re sult + ATi me;
  316   end;
  317  
  318   procedure  LoadEllips is(bitmap:  TBitMap;  BlackColor Mode: bool ean);
  319   var
  320     ResName:  string;
  321   begin
  322     if Black ColorMode  then
  323       ResNam e := 'BLAC K_BMP_ELLI PSIS'
  324     else
  325       ResNam e := 'BMP_ ELLIPSIS';
  326     bitmap.L oadFromRes ourceName( hInstance,  ResName);
  327   end;
  328  
  329   { TfrmORDt Tm ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- --- }
  330  
  331   procedure  TORfrmDtTm .FormCreat e(Sender:  TObject);
  332   begin
  333     ResizeAn choredForm ToFont(sel f);
  334     //FormSt yle := fsS tayOnTop;
  335     lstHour. TopIndex : = 6;
  336     FFromSel f := False ;
  337     calSelec tChange(Se lf);
  338   end;
  339  
  340   procedure  TORfrmDtTm .calSelect Change(Sen der: TObje ct);
  341   begin
  342     lblDate. Caption :=  FormatDat eTime('mmm m d, yyyy' , calSelec t.Calendar Date);
  343     FNowPres sed := Fal se;
  344   end;
  345  
  346   procedure  TORfrmDtTm .imgPrevMo nthMouseDo wn(Sender:  TObject;
  347     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  348   begin
  349     pnlPrevM onth.Bevel Outer := b vLowered;
  350   end;
  351  
  352   procedure  TORfrmDtTm .imgNextMo nthMouseDo wn(Sender:  TObject;
  353     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  354   begin
  355     pnlNextM onth.Bevel Outer := b vLowered;
  356   end;
  357  
  358   procedure  TORfrmDtTm .imgPrevMo nthClick(S ender: TOb ject);
  359   begin
  360     calSelec t.PrevMont h;
  361   end;
  362  
  363   procedure  TORfrmDtTm .imgNextMo nthClick(S ender: TOb ject);
  364   begin
  365     calSelec t.NextMont h;
  366   end;
  367  
  368   procedure  TORfrmDtTm .imgPrevMo nthMouseUp (Sender: T Object;
  369     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  370   begin
  371     pnlPrevM onth.Bevel Outer := b vRaised;
  372   end;
  373  
  374   procedure  TORfrmDtTm .imgNextMo nthMouseUp (Sender: T Object;
  375     Button:  TMouseButt on; Shift:  TShiftSta te; X, Y:  Integer);
  376   begin
  377      pnlNext Month.Beve lOuter :=  bvRaised;
  378   end;
  379  
  380   procedure  TORfrmDtTm .cmdTodayC lick(Sende r: TObject );
  381   begin
  382     calSelec t.Calendar Date := Se rverToday;
  383     lstHour. ItemIndex  := -1;
  384     lstMinut e.ItemInde x := -1;
  385     txtTime. Text := '' ;
  386   end;
  387  
  388   procedure  TORfrmDtTm .txtTimeCh ange(Sende r: TObject );
  389   begin
  390     if not F FromSelf t hen
  391     begin
  392       lstHou r.ItemInde x := -1;
  393       lstMin ute.ItemIn dex := -1;
  394     end;
  395     FNowPres sed := Fal se;
  396   end;
  397  
  398   procedure  TORfrmDtTm .lstHourCl ick(Sender : TObject) ;
  399   begin
  400     if lstHo ur.ItemInd ex = 0 the n lstMinut e.Items[0]  := ':01   --' else l stMinute.I tems[0] :=  ':00  --' ; //<----- - NEW CODE
  401     if lstMi nute.ItemI ndex < 0 t hen lstMin ute.ItemIn dex := 0;
  402     lstMinut eClick(Sel f);
  403   end;
  404  
  405   procedure  TORfrmDtTm .lstMinute Click(Send er: TObjec t);
  406   var
  407     AnHour,  AMinute: I nteger;
  408   //  AmPm:  string;
  409   begin
  410     if lstHo ur.ItemInd ex < 0 the n Exit;
  411  
  412     // if am pm time -
  413     //case l stHour.Ite mIndex of
  414     //    0:  AnHour :=  12;
  415     //1..12:  AnHour :=  lstHour.I temIndex;
  416     //else    AnHour :=  lstHour.I temIndex -  12;
  417     //end;
  418     //if lst Hour.ItemI ndex > 11  then AmPm  := 'PM' el se AmPm :=  'AM';
  419  
  420     // if mi litary tim e
  421     AnHour : = lstHour. ItemIndex;
  422  
  423     AMinute  := lstMinu te.ItemInd ex * 5;
  424     if (AnHo ur = 0) an d (AMinute  = 0) then  AMinute : = 1;  //<- ---------- --- NEW CO DE
  425     FFromSel f := True;
  426     // if am pm time -
  427     //txtTim e.Text :=  Format('%d :%.2d ' +  AmPm, [AnH our, AMinu te]);
  428  
  429     // if mi litary tim e
  430     txtTime. Text := Fo rmat('%.2d :%.2d ', [ AnHour, AM inute]);
  431  
  432     FFromSel f := False ;
  433   end;
  434  
  435   procedure  TORfrmDtTm .cmdNowCli ck(Sender:  TObject);
  436   begin
  437     calSelec t.Calendar Date := Se rverToday;
  438     //txtTim e.Text :=  FormatDate Time('h:nn  ampm', Se rverNow);   // if amp m time
  439     txtTime. Text := Fo rmatDateTi me('hh:nn' , ServerNo w);         // if amp m time
  440     FNowPres sed := Tru e;
  441   end;
  442  
  443   procedure  TORfrmDtTm .cmdMidnig htClick(Se nder: TObj ect);
  444   begin
  445     //txtTim e.Text :=  '11:59 PM' ;  // if a mpm time
  446     txtTime. Text := '2 3:59';       // if mi litary tim e
  447   end;
  448  
  449   procedure  TORfrmDtTm .cmdOKClic k(Sender:  TObject);
  450   var
  451     x: strin g;
  452   begin
  453     if TimeI sRequired  and (Lengt h(txtTime. Text) = 0)  then
  454     begin
  455       InfoBo x('An entr y for time  is requir ed.', 'Mis sing Time' , MB_OK);
  456       Exit;
  457     end;
  458     if Lengt h(txtTime. Text) > 0  then
  459     begin
  460       x := T rim(txtTim e.Text);
  461       //if ( x='00:00')  or (x='0: 00') or (x ='00:00:00 ') or (x=' 0:00:00')  then x :=  '00:00:01' ;
  462       if (x= '00:00') o r (x='0:00 ') or (x=' 00:00:00')  or (x='0: 00:00') th en x := '0 0:01';  // <------- C HANGED COD E
  463       StrToT ime(x);
  464       txtTim e.Text :=  x;
  465     end;
  466     ModalRes ult := mrO K;
  467   end;
  468  
  469   procedure  TORfrmDtTm .cmdCancel Click(Send er: TObjec t);
  470   begin
  471     ModalRes ult := mrC ancel;
  472   end;
  473  
  474   procedure  TORfrmDtTm .Loaded;
  475   begin
  476     inherite d Loaded;
  477     UpdateCo lorsFor508 Compliance (Self);
  478   end;
  479  
  480   { TORDateT imeDlg }
  481  
  482   constructo r TORDateT imeDlg.Cre ate(AOwner : TCompone nt);
  483   begin
  484     inherite d Create(A Owner);
  485     if not ( csDesignin g in Compo nentState)
  486       then F DateTime : = ServerTo day
  487       else F DateTime   := SysUtil s.Date;
  488   end;
  489  
  490   function T ORDateTime Dlg.Execut e: Boolean ;
  491   const
  492     HORZ_SPA CING = 8;
  493   var
  494     frmDtTm:  TORfrmDtT m;
  495   begin
  496     frmDtTm  := TORfrmD tTm.Create (Applicati on);
  497     try
  498       with f rmDtTm do
  499       begin
  500         calS elect.Cale ndarDate : = Int(FDat eTime);
  501         if F rac(FDateT ime) > 0
  502           // then txtTi me.Text :=  FormatDat eTime('h:n n ampm', F DateTime);   // if am pm time
  503           th en txtTime .Text := F ormatDateT ime('hh:nn ', FDateTi me);         // if mi litary tim e
  504         if R equireTime  then Time IsRequired  := True;
  505         if D ateOnly th en
  506         begi n
  507           tx tTime.Visi ble     :=  False;
  508           ls tHour.Visi ble     :=  False;
  509           ls tMinute.Vi sible   :=  False;
  510           cm dNow.Visib le      :=  False;
  511           cm dMidnight. Visible :=  False;
  512           bv lFrame.Wid th := bvlF rame.Width  - txtTime .Width - H ORZ_SPACIN G;
  513           cm dOK.Left : = cmdOK.Le ft - txtTi me.Width -  HORZ_SPAC ING;
  514           cm dCancel.Le ft := cmdO K.Left;
  515           Cl ientWidth  := ClientW idth - txt Time.Width  - HORZ_SP ACING;
  516         end;
  517         Resu lt := (Sho wModal = I DOK);
  518         if R esult then
  519         begi n
  520           FD ateTime :=  Int(calSe lect.Calen darDate);
  521           if  Length(tx tTime.Text ) > 0 then  FDateTime  := FDateT ime + StrT oTime(txtT ime.Text);
  522           if  FNowPress ed
  523              then FRela tiveTime : = 'NOW'
  524              else FRela tiveTime : = Relative DateTime(F DateTime);
  525         end;
  526       end;
  527     finally
  528       frmDtT m.Free;
  529     end;
  530   end;
  531  
  532   function T ORDateTime Dlg.GetFMD ateTime: T FMDateTime ;
  533   begin
  534     Result : = DateTime ToFMDateTi me(FDateTi me);
  535   end;
  536  
  537   procedure  TORDateTim eDlg.SetDa teOnly(Val ue: Boolea n);
  538   begin
  539     FDateOnl y := Value ;
  540     if FDate Only then
  541     begin
  542       FRequi reTime :=  False;
  543       FDateT ime := Int (FDateTime );
  544     end;
  545   end;
  546  
  547   procedure  TORDateTim eDlg.SetFM DateTime(V alue: TFMD ateTime);
  548   begin
  549     if Value  > 0 then  FDateTime  := FMDateT imeToDateT ime(Value) ;
  550   end;
  551  
  552   procedure  TORDateTim eDlg.SetRe quireTime( Value: Boo lean);
  553   begin
  554     FRequire Time := Va lue;
  555     if FRequ ireTime th en FDateOn ly := Fals e;
  556   end;
  557  
  558   { TORDateE dit ------ ---------- ---------- ---------- ---------- ---------- ---------- ---------- - }
  559  
  560   procedure  TORDateEdi t.CreatePa rams(var P arams: TCr eateParams );
  561   { sets a o ne line ed it box to  multiline  style so t he editing  rectangle  can be ch anged }
  562   begin
  563     inherite d CreatePa rams(Param s);
  564     Params.S tyle := Pa rams.Style  or ES_MUL TILINE or  WS_CLIPCHI LDREN;
  565   end;
  566  
  567  
  568   { TORDateB ox ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- --- }
  569  
  570   constructo r TORDateB ox.Create( AOwner: TC omponent);
  571   begin
  572     inherite d Create(A Owner);
  573     FButton  := TORDate Button.Cre ate(Self);
  574     FButton. Parent :=  Self;
  575     FButton. Width := 1 8;
  576     FButton. Height :=  17;
  577     FButton. OnClick :=  ButtonCli ck;
  578     FButton. TabStop :=  False;
  579     FBlackCo lorMode :=  False;
  580     LoadElli psis(FButt on.Glyph,  FALSE);
  581     FButton. Visible :=  True;
  582     FFormat  := FMT_DAT ETIME;
  583   end;
  584  
  585   procedure  TORDateBox .WMSize(va r Message:  TWMSize);
  586   var
  587     ofs: int eger;
  588  
  589   begin
  590     inherite d;
  591     if assig ned(FButto n) then
  592     begin
  593       if Bor derStyle =  bsNone th en
  594         ofs  := 0
  595       else
  596         ofs  := 4;
  597       FButto n.SetBound s(Width -  FButton.Wi dth - ofs,  0, FButto n.Width, H eight - of s);
  598     end;
  599     SetEditR ect;
  600   end;
  601  
  602   procedure  TORDateBox .SetTempla teField(co nst Value:  boolean);
  603   var
  604     Y: integ er;
  605  
  606   begin
  607     if(FTemp lateField  <> Value)  then
  608     begin
  609       FTempl ateField : = Value;
  610       Y := T extHeightB yFont(Font .Handle, F ontHeightT ext);
  611       if Val ue then
  612       begin
  613         FBut ton.Width  := Y+2;
  614         Heig ht := Y;
  615         Bord erStyle :=  bsNone;
  616       end
  617       else
  618       begin
  619         FBut ton.Width  := 18;
  620         Heig ht := y +  AdjVertSiz e;
  621         Bord erStyle :=  bsSingle;
  622       end;
  623     end;
  624   end;
  625  
  626   function T ORDateBox. SupportsDy namicPrope rty(Proper tyID: inte ger): bool ean;
  627   begin
  628     Result : = (Propert yID = Dyna PropAccesi bilityCapt ion);
  629   end;
  630  
  631   procedure  TORDateBox .ButtonCli ck(Sender:  TObject);
  632   var
  633     DateDial og: TORDat eTimeDlg;
  634     ParsedDa te: TFMDat eTime;
  635   begin
  636     DateDial og := TORD ateTimeDlg .Create(Ap plication) ;
  637     if Lengt h(Text) >  0 then
  638     begin
  639       Parsed Date := Se rverParseF MDate(Text );
  640       if Par sedDate >  -1 then FF MDateTime  := ParsedD ate else F FMDateTime  := 0;
  641     end;
  642     DateDial og.DateOnl y := FDate Only;
  643     DateDial og.FMDateT ime := FFM DateTime;
  644     DateDial og.Require Time := FR equireTime ;
  645     if DateD ialog.Exec ute then
  646     begin
  647       FFMDat eTime := D ateDialog. FMDateTime ;
  648       Update Text;
  649       FTimeI sNow := Da teDialog.R elativeTim e = 'NOW';
  650     end;
  651     DateDial og.Free;
  652     if Assig ned(OnDate DialogClos ed) then O nDateDialo gClosed(Se lf);
  653     if Visib le and Ena bled then  //Some eve nts may hi de the com ponent
  654       SetFoc us;
  655   end;
  656  
  657   procedure  TORDateBox .Change;
  658   begin
  659     inherite d Change;
  660     FTimeIsN ow := Fals e;
  661   end;
  662  
  663   procedure  TORDateBox .KeyDown(v ar Key: Wo rd; Shift:  TShiftSta te);
  664   begin
  665     inherite d KeyDown( Key, Shift );
  666     if (Key  = VK_RETUR N) then be gin
  667       FButto n.Click;
  668       Key :=  0;
  669     end;
  670   end;
  671  
  672   function T ORDateBox. GetFMDateT ime: TFMDa teTime;
  673   begin
  674     Result : = 0;
  675     if Lengt h(Text) >  0 then Res ult := Ser verParseFM Date(Text) ;
  676     FFMDateT ime := Res ult;
  677   end;
  678  
  679   function T ORDateBox. GetRelativ eTime: str ing;
  680   begin
  681     Result : = '';
  682     if FTime IsNow then  Result :=  'NOW'
  683     else if  UpperCase( Text) = 'N OW' then R esult := ' NOW'
  684     else if  Length(Tex t) > 0 the n
  685     begin
  686       FFMDat eTime := S erverParse FMDate(Tex t);
  687       if FFM DateTime >  0 then Re sult := Re lativeDate Time(FMDat eTimeToDat eTime(FFMD ateTime));
  688     end;
  689   end;
  690  
  691   procedure  TORDateBox .SetDateOn ly(Value:  Boolean);
  692   begin
  693     FDateOnl y := Value ;
  694     if FDate Only then
  695     begin
  696       FRequi reTime :=  False;
  697       FFMDat eTime := I nt(FFMDate Time);
  698       if FFo rmat = FMT _DATETIME  then FForm at := FMT_ DATEONLY;
  699     end;
  700     UpdateTe xt;
  701   end;
  702  
  703   procedure  TORDateBox .SetFMDate Time(Value : TFMDateT ime);
  704   begin
  705     FFMDateT ime := Val ue;
  706     UpdateTe xt;
  707   end;
  708  
  709   procedure  TORDateBox .SetRequir eTime(Valu e: Boolean );
  710   begin
  711     FRequire Time := Va lue;
  712     if FRequ ireTime th en
  713     begin
  714       if FFo rmat = FMT _DATEONLY  then FForm at := FMT_ DATETIME;
  715       SetDat eOnly(Fals e);
  716     end;
  717   end;
  718  
  719   procedure  TORDateBox .SetEditRe ct;
  720   { change t he edit re ctangle to  not hide  the calend ar button  - taken fr om SPIN.PA S sample }
  721   var
  722     Loc: TRe ct;
  723   begin
  724     SendMess age(Handle , EM_GETRE CT, 0, Lon gInt(@Loc) );
  725     Loc.Bott om := Clie ntHeight +  1;                //  +1 is wor karound fo r windows  paint bug
  726     Loc.Righ t  := FBut ton.Left -  2;
  727     Loc.Top     := 0;
  728     Loc.Left    := 0;
  729     SendMess age(Handle , EM_SETRE CTNP, 0, L ongInt(@Lo c));
  730   end;
  731  
  732   procedure  TORDateBox .UpdateTex t;
  733   begin
  734     if FFMDa teTime > 0  then
  735     begin
  736       if (FF ormat =FMT _DATETIME)  and (Frac (FFMDateTi me) = 0)
  737         then  Text := F ormatFMDat eTime(FMT_ DATEONLY,  FFMDateTim e)
  738         else  Text := F ormatFMDat eTime(FFor mat, FFMDa teTime);
  739     end;
  740   end;
  741  
  742   procedure  TORDateBox .Validate( var ErrMsg : string);
  743   begin
  744     ErrMsg : = '';
  745     if Lengt h(Text) >  0 then
  746     begin
  747      {
  748   !!!!!! THI S HAS BEEN  REMOVED A S IT CAUSE D PROBLEMS  WITH REMI NDER DIALO GS -  DN S      BELLC !!!! !!
  749       //We n eed to mak e sure tha t there is  a date en tered befo re parse
  750       if FRe quireTime  and ((Pos( '@', Text)  = 0) or ( Length(Pie ce(Text, ' @', 1)) =  0)) then
  751        ErrMs g := 'Date  Required' ;
  752       }
  753       FFMDat eTime := S erverParse FMDate(Tex t);
  754       if FFM DateTime < = 0 then E rrmsg := ' Invalid Da te/Time';
  755       if FRe quireTime  and (Frac( FFMDateTim e) = 0) th en ErrMsg  := 'Time R equired';
  756       if FDa teOnly     and (Frac( FFMDateTim e) > 0) th en ErrMsg  := 'Time n ot Require d';
  757     end;
  758   end;
  759  
  760   function T ORDateBox. IsValid: B oolean;
  761   var
  762     x: strin g;
  763   begin
  764     Validate (x);
  765     if Lengt h(x) = 0 t hen Result  := True e lse Result  := False;
  766     if Lengt h(Text) =  0 then Res ult := Fal se;
  767   end;
  768  
  769   procedure  TORDateBox .SetBlackC olorMode(V alue: bool ean);
  770   begin
  771     if FBlac kColorMode  <> Value  then
  772     begin
  773       FBlack ColorMode  := Value;
  774       LoadEl lipsis(FBu tton.Glyph , FBlackCo lorMode);
  775     end;
  776   end;
  777  
  778   procedure  TORDateBox .SetCaptio n(const Va lue: strin g);
  779   begin
  780       if not  Assigned( FCaption)  then begin
  781          FCa ption := T StaticText .Create(se lf);
  782          FCa ption.Auto Size := Fa lse;
  783          FCa ption.Heig ht := 0;
  784          FCa ption.Widt h  := 0;
  785          FCa ption.Visi ble := Tru e;
  786          FCa ption.Pare nt := Pare nt;
  787          FCa ption.Brin gtoFront;
  788       end;
  789       FCapti on.Caption  := Value;
  790   end;
  791  
  792   procedure  TORDateBox .SetEnable d(Value: B oolean);
  793   begin
  794     FButton. Enabled :=  Value;
  795     inherite d;
  796   end;
  797  
  798   function T ORDateBox. GetCaption (): string ;
  799   begin
  800       result  := FCapti on.Caption ;
  801   end;
  802  
  803   function T ORDateBox. GetDynamic Property(P ropertyID:  integer):  string;
  804   begin
  805     if Prope rtyID = Dy naPropAcce sibilityCa ption then
  806       Result  := GetCap tion
  807     else
  808       Result  := '';
  809   end;
  810  
  811   function I sLeapYear( AYear: Int eger): Boo lean;
  812   begin
  813     Result : = (AYear m od 4 = 0)  and ((AYea r mod 100  <> 0) or ( AYear mod  400 = 0));
  814   end;
  815  
  816   function D aysPerMont h(AYear, A Month: Int eger): Int eger;
  817   const
  818     DaysInMo nth: array [1..12] of  Integer =  (31, 28,  31, 30, 31 , 30, 31,  31, 30, 31 , 30, 31);
  819  
  820   begin
  821     if(AYear  < 1) or ( AMonth < 1 ) then
  822       Result  := 0
  823     else
  824     begin
  825       Result  := DaysIn Month[AMon th];
  826       if (AM onth = 2)  and IsLeap Year(AYear ) then Inc (Result);  { leap-yea r Feb is s pecial }
  827     end;
  828   end;
  829  
  830   { TORDateC ombo ----- ---------- ---------- ---------- ---------- ---------- ---------- -------- }
  831  
  832   const
  833     ComboBox AdjSize =  24;
  834     EditAdjH orzSize =  8;
  835     DateComb oCtrlGap =  2;
  836     FirstYea r = 1800;
  837     LastYear  = 2200;
  838  
  839   { TORDateC omboEdit }
  840  
  841   procedure  TORYearEdi t.SetTempl ateField(c onst Value : boolean) ;
  842   begin
  843     if(FTemp lateField  <> Value)  then
  844     begin
  845       FTempl ateField : = Value;
  846       if Val ue then
  847         Bord erStyle :=  bsNone
  848       else
  849         Bord erStyle :=  bsSingle;
  850     end;
  851   end;
  852  
  853   { TORDateC ombo }
  854  
  855   constructo r TORDateC ombo.Creat e(AOwner:  TComponent );
  856   begin
  857     inherite d;
  858     ControlS tyle := Co ntrolStyle  - [csSetC aption, cs AcceptsCon trols];
  859     BevelOut er := bvNo ne;
  860     FInclude Month := T RUE;
  861     FInclude Day := TRU E;
  862     FInclude Btn := TRU E;
  863     OnResize  := Resize d;
  864     FORYearE ditClass : = TORYearE dit;
  865   end;
  866  
  867   destructor  TORDateCo mbo.Destro y;
  868   begin
  869     KillObj( @FMonthCom bo);
  870     KillObj( @FDayCombo );
  871     KillObj( @FYearEdit );
  872     KillObj( @FYearUD);
  873     KillObj( @FCalBtn);
  874     inherite d;
  875   end;
  876  
  877   function T ORDateComb o.GetYearS ize: integ er;
  878   begin
  879     Result : = TextWidt hByFont(Fo nt.Handle,  '8888') +  EditAdjHo rzSize;
  880   end;
  881  
  882   function T ORDateComb o.InitDays (GetSize:  boolean):  integer;
  883   var
  884     dy: inte ger;
  885  
  886   begin
  887     Result : = 0;
  888     if(assig ned(FDayCo mbo)) then
  889     begin
  890       dy :=  DaysPerMon th(FYear,  FMonth) +  1;
  891       while  (FDayCombo .Items.Cou nt < dy) d o
  892       begin
  893         if(F DayCombo.I tems.Count  = 0) then
  894           FD ayCombo.It ems.Add('  ')
  895         else
  896           FD ayCombo.It ems.Add(in ttostr(FDa yCombo.Ite ms.Count)) ;
  897       end;
  898       while  (FDayCombo .Items.Cou nt > dy) d o
  899         FDay Combo.Item s.Delete(F DayCombo.I tems.Count -1);
  900       if(Get Size) then
  901         Resu lt := Text WidthByFon t(Font.Han dle, '88')  + ComboBo xAdjSize;
  902       if(FDa y > (dy-1) ) then
  903         SetD ay(dy-1);
  904     end;
  905   end;
  906  
  907   function T ORDateComb o.InitMont hs(GetSize : boolean) : integer;
  908   var
  909     i, Size:  integer;
  910  
  911   begin
  912     Result : = 0;
  913     if(assig ned(FMonth Combo)) th en
  914     begin
  915       FMonth Combo.Item s.Clear;
  916       FMonth Combo.Item s.Add(' ') ;
  917       for i  := 1 to 12  do
  918       begin
  919         if F LongMonths  then
  920           FM onthCombo. Items.Add( FormatSett ings.LongM onthNames[ i]) // 2FA
  921         else
  922           FM onthCombo. Items.Add( FormatSett ings.Short MonthNames [i]); // 2 FA
  923         if(G etSize) th en
  924         begi n
  925           Si ze := Text WidthByFon t(Font.Han dle, FMont hCombo.Ite ms[i]);
  926           if (Result <  Size) then
  927              Result :=  Size;
  928         end;
  929       end;
  930       if(Get Size) then
  931         inc( Result, Co mboBoxAdjS ize);
  932     end;
  933   end;
  934  
  935   procedure  TORDateCom bo.Rebuild ;
  936   var
  937     Wide, X,  Y: intege r;
  938  
  939   begin
  940     if(not F Rebuilding ) then
  941     begin
  942       FRebui lding := T RUE;
  943       try
  944         Cont rolStyle : = ControlS tyle + [cs AcceptsCon trols];
  945         try
  946           Y  := TextHei ghtByFont( Font.Handl e, FontHei ghtText);
  947           if  not FTemp lateField  then
  948              inc(Y,AdjV ertSize);
  949           X  := 0;
  950           if (FIncludeM onth) then
  951           be gin
  952              if(not ass igned(FMon thCombo))  then
  953              begin
  954                FMonthCo mbo := TOR MonthCombo .Create(Se lf);
  955                FMonthCo mbo.Parent  := Self;
  956                FMonthCo mbo.Top :=  0;
  957                FMonthCo mbo.Left : = 0;
  958                FMonthCo mbo.Style  := orcsDro pDown;
  959                FMonthCo mbo.DropDo wnCount :=  13;
  960                FMonthCo mbo.ListIt emsOnly :=  True;
  961                FMonthCo mbo.OnChan ge := Mont hChanged;
  962              end;
  963              FMonthComb o.Font :=  Font;
  964              FMonthComb o.Template Field := F TemplateFi eld;
  965              Wide := In itMonths(T RUE);
  966              FMonthComb o.Width :=  Wide;
  967              FMonthComb o.Height : = Y;
  968              FMonthComb o.ItemInde x := FMont h;
  969              inc(X, Wid e + DateCo mboCtrlGap );
  970  
  971              if(FInclud eDay) then
  972              begin
  973                if(not a ssigned(FD ayCombo))  then
  974                begin
  975                  FDayCo mbo := TOR DayCombo.C reate(Self );
  976                  FDayCo mbo.Parent  := Self;
  977                  FDayCo mbo.Top :=  0;
  978                  FDayCo mbo.Style  := orcsDro pDown;
  979                  FDayCo mbo.ListIt emsOnly :=  True;
  980                  FDayCo mbo.OnChan ge := DayC hanged;
  981                  FDayCo mbo.DropDo wnCount :=  11;
  982                end;
  983                FDayComb o.Font :=  Font;
  984                FDayComb o.Template Field := F TemplateFi eld;
  985                Wide :=  InitDays(T RUE);
  986                FDayComb o.Width :=  Wide;
  987                FDayComb o.Height : = Y;
  988                FDayComb o.Left :=  X;
  989                FDayComb o.ItemInde x := FDay;
  990                inc(X, W ide + Date ComboCtrlG ap);
  991              end
  992              else
  993                KillObj( @FDayCombo );
  994           en d
  995           el se
  996           be gin
  997              KillObj(@F DayCombo);
  998              KillObj(@F MonthCombo );
  999           en d;
  1000           if (not assig ned(FYearE dit)) then
  1001           be gin
  1002              FYearEdit  := FORYear EditClass. Create(Sel f);
  1003              FYearEdit. Parent :=  Self;
  1004              FYearEdit. Top := 0;
  1005              FYearEdit. EditMask : = '9999;1;  ';
  1006              FYearEdit. OnKeyPress  := YearKe yPress;
  1007              FYearEdit. OnChange : = YearChan ged;
  1008           en d;
  1009           FY earEdit.Fo nt := Font ;
  1010           FY earEdit.Te mplateFiel d := FTemp lateField;
  1011           Wi de := GetY earSize;
  1012           FY earEdit.Wi dth := Wid e;
  1013           FY earEdit.He ight := Y;
  1014           FY earEdit.Le ft := X;
  1015           in c(X, Wide) ;
  1016           if (not assig ned(FYearU D)) then
  1017           be gin
  1018              FYearUD :=  TUpDown.C reate(Self );
  1019              FYearUD.Pa rent := Se lf;
  1020              FYearUD.Th ousands :=  FALSE;
  1021              FYearUD.Mi n := First Year-1;
  1022              FYearUD.Ma x := LastY ear;
  1023              FYearUD.On ChangingEx  := YearUD Change;
  1024           en d;
  1025           FY earEdit.Ta bOrder :=  0;
  1026           FY earUD.Top  := 0;
  1027           FY earUD.Left  := X;
  1028           FY earUD.Heig ht := Y;
  1029           FY earUD.Posi tion := FY ear;
  1030           in c(X, FYear UD.Width +  DateCombo CtrlGap);
  1031           if (FIncludeB tn) then
  1032           be gin
  1033              if(not ass igned(FCal Btn)) then
  1034              begin
  1035                FCalBtn  := TORDate Button.Cre ate(Self);
  1036                FCalBtn. TabStop :=  FALSE;
  1037                FCalBtn. Parent :=  Self;
  1038                FCalBtn. Top := 0;
  1039                LoadElli psis(FCalB tn.Glyph,  FBlackColo rMode);
  1040                FCalBtn. OnClick :=  BtnClicke d;
  1041              end;
  1042              Wide := FY earEdit.He ight;
  1043              if(Wide >  Y) then Wi de := Y;
  1044              FCalBtn.Wi dth := Wid e;
  1045              FCalBtn.He ight := Wi de;
  1046              FCalBtn.Le ft := X;
  1047              inc(X, Wid e + DateCo mboCtrlGap );
  1048           en d
  1049           el se
  1050              KillObj(@F CalBtn);
  1051           Se lf.Width : = X - Date ComboCtrlG ap;
  1052           Se lf.Height  := Y;
  1053           Ch eckDays;
  1054           FC trlsCreate d := TRUE;
  1055           Do Change;
  1056         fina lly
  1057           Co ntrolStyle  := Contro lStyle - [ csAcceptsC ontrols];
  1058         end;
  1059       finall y
  1060         FReb uilding :=  FALSE;
  1061       end;
  1062     end;
  1063   end;
  1064  
  1065   procedure  TORDateCom bo.SetBlac kColorMode (Value: bo olean);
  1066   begin
  1067     if FBlac kColorMode  <> Value  then
  1068     begin
  1069       FBlack ColorMode  := Value;
  1070       if ass igned(FCal Btn) then     
  1071         Load Ellipsis(F CalBtn.Gly ph, FBlack ColorMode) ;
  1072     end;
  1073   end;
  1074  
  1075   procedure  TORDateCom bo.SetDay( Value: int eger);
  1076   begin
  1077     if(not a ssigned(FD ayCombo))  and (not ( csLoading  in Compone ntState))  then
  1078       Value  := 0;
  1079     if(Value  > DaysPer Month(FYea r, FMonth) ) then
  1080       Value  := 0;
  1081     if(FDay  <> Value)  then
  1082     begin
  1083       FDay : = Value;
  1084       if(ass igned(FDay Combo)) th en
  1085       begin
  1086         if(F DayCombo.I tems.Count  <= FDay)  then
  1087           In itDays(FAL SE);
  1088         FDay Combo.Item Index := F Day;
  1089       end;
  1090       DoChan ge;
  1091     end;
  1092   end;
  1093  
  1094   procedure  TORDateCom bo.SetIncl udeBtn(con st Value:  boolean);
  1095   begin
  1096     if(FIncl udeBtn <>  Value) the n
  1097     begin
  1098       FInclu deBtn := V alue;
  1099       Rebuil d;
  1100     end;
  1101   end;
  1102  
  1103   procedure  TORDateCom bo.SetIncl udeDay(Val ue: boolea n);
  1104   begin
  1105     if(Value ) and (not  FIncludeM onth) then
  1106       Value  := FALSE;
  1107     if(FIncl udeDay <>  Value) the n
  1108     begin
  1109       FInclu deDay := V alue;
  1110       if(not  Value) th en FDay :=  0;
  1111       Rebuil d;
  1112     end;
  1113   end;
  1114  
  1115   procedure  TORDateCom bo.SetIncl udeMonth(c onst Value : boolean) ;
  1116   begin
  1117     if(FIncl udeMonth < > Value) t hen
  1118     begin
  1119       FInclu deMonth :=  Value;
  1120       if(not  Value) th en
  1121       begin
  1122         FInc ludeDay :=  FALSE;
  1123         FMon th := 0;
  1124         FDay  := 0;
  1125       end;
  1126       Rebuil d;
  1127     end;
  1128   end;
  1129  
  1130   procedure  TORDateCom bo.SetMont h(Value: i nteger);
  1131   begin
  1132     if(not a ssigned(FM onthCombo) ) and (not  (csLoadin g in Compo nentState) ) then
  1133       Value  := 0;
  1134     if(Value  <0) or (V alue > 12)  then
  1135       Value  := 0;
  1136     if(FMont h <> Value ) then
  1137     begin
  1138       FMonth  := Value;
  1139       if(ass igned(FMon thCombo))  then
  1140         FMon thCombo.It emIndex :=  FMonth;
  1141       CheckD ays;
  1142       DoChan ge;
  1143     end;
  1144   end;
  1145  
  1146   procedure  TORDateCom bo.SetLong Months(con st Value:  boolean);
  1147   begin
  1148     if(FLong Months <>  Value) the n
  1149     begin
  1150       FLongM onths := V alue;
  1151       Rebuil d;
  1152     end;
  1153   end;
  1154  
  1155   procedure  TORDateCom bo.SetYear (const Val ue: intege r);
  1156   begin
  1157     if(FYear  <> Value)  then
  1158     begin
  1159       FYear  := Value;
  1160       if(FYe ar < First Year) or ( FYear > La stYear) th en
  1161         FYea r := 0;
  1162       if(not  FYearChan ging) and  (assigned( FYearEdit) ) and (ass igned(FYea rUD)) then
  1163       begin
  1164         FYea rChanging  := TRUE;
  1165         try
  1166           if (FYear = 0 ) then
  1167           be gin
  1168              FYearEdit. Text := '     ';
  1169              FYearUD.Po sition :=  FirstYear- 1
  1170           en d
  1171           el se
  1172           be gin
  1173              FYearEdit. Text := In tToStr(FYe ar);
  1174              FYearUD.Po sition :=  FYear;
  1175           en d;
  1176         fina lly
  1177           FY earChangin g := FALSE ;
  1178         end;
  1179       end;
  1180       if(FMo nth = 2) t hen
  1181         Init Days(FALSE );
  1182       CheckD ays;
  1183       DoChan ge;
  1184     end;
  1185   end;
  1186  
  1187   procedure  TORDateCom bo.DayChan ged(Sender : TObject) ;
  1188   begin
  1189     FDay :=  FDayCombo. ItemIndex;
  1190     if(FDay  < 0) then
  1191       FDay : = 0;
  1192     CheckDay s;
  1193     DoChange ;
  1194   end;
  1195  
  1196   procedure  TORDateCom bo.MonthCh anged(Send er: TObjec t);
  1197   begin
  1198     FMonth : = FMonthCo mbo.ItemIn dex;
  1199     if(FMont h < 0) the n
  1200       FMonth  := 0;
  1201     InitDays (FALSE);
  1202     CheckDay s;
  1203     DoChange ;
  1204   end;
  1205  
  1206   procedure  TORDateCom bo.YearCha nged(Sende r: TObject );
  1207   begin
  1208     if FYear Changing t hen exit;
  1209     FYearCha nging := T RUE;
  1210     try
  1211       FYear  := StrToIn tDef(FYear Edit.Text,  0);
  1212       if(FYe ar < First Year) or ( FYear > La stYear) th en
  1213         FYea r := 0;
  1214       if(FYe ar = 0) th en
  1215         FYea rUD.Positi on := Firs tYear-1
  1216       else
  1217         FYea rUD.Positi on := FYea r;
  1218       if(FMo nth = 2) t hen
  1219         Init Days(FALSE );
  1220       CheckD ays;
  1221       DoChan ge;
  1222     finally
  1223       FYearC hanging :=  FALSE;
  1224     end;
  1225   end;
  1226  
  1227   procedure  TORDateCom bo.CheckDa ys;
  1228   var
  1229     MaxDays:  integer;
  1230  
  1231   begin
  1232     if(FIncl udeMonth a nd assigne d(FMonthCo mbo)) then
  1233     begin
  1234       FMonth Combo.Enab led := (FY ear > 0);
  1235       if (FY ear = 0) t hen
  1236         SetM onth(0); 
  1237       if(FIn cludeMonth  and FIncl udeDay and  assigned( FDayCombo) ) then
  1238       begin
  1239         FDay Combo.Enab led := ((F Year > 0)  and (FMont h > 0));
  1240         MaxD ays := Day sPerMonth( FYear, FMo nth);
  1241         if(F Day > MaxD ays) then
  1242           Se tDay(MaxDa ys);
  1243       end;
  1244     end;
  1245   end;
  1246  
  1247   procedure  TORDateCom bo.Loaded;
  1248   begin
  1249     inherite d;
  1250     if(not F CtrlsCreat ed) then
  1251       Rebuil d;
  1252   end;
  1253  
  1254   procedure  TORDateCom bo.Paint;
  1255   begin
  1256     if(not F CtrlsCreat ed) then
  1257       Rebuil d;
  1258     inherite d;
  1259   end;
  1260  
  1261   procedure  TORDateCom bo.BtnClic ked(Sender : TObject) ;
  1262   var
  1263     mm, dd,  yy: intege r;
  1264     m, d, y:  word;
  1265     DateDial og: TORDat eTimeDlg;
  1266  
  1267   begin
  1268     DateDial og := TORD ateTimeDlg .Create(se lf);
  1269     try
  1270       mm :=  FMonth;
  1271       dd :=  FDay;
  1272       yy :=  FYear;
  1273       Decode Date(Now,  y, m, d);
  1274       if(FYe ar = 0) th en FYear : = y;
  1275       if(FYe ar = y) th en
  1276       begin
  1277         if(( FMonth = 0 ) or (FMon th = m)) a nd (FDay =  0) then
  1278         begi n
  1279           FM onth := m;
  1280           FD ay := d;
  1281         end;
  1282       end;
  1283       if(FMo nth = 0) t hen
  1284         FMon th := 1;
  1285       if(FDa y = 0) the n
  1286         FDay  := 1;
  1287       DateDi alog.FMDat eTime := G etFMDate;
  1288       DateDi alog.DateO nly := TRU E;
  1289       DateDi alog.Requi reTime :=  FALSE;
  1290       if Dat eDialog.Ex ecute then
  1291       begin
  1292         FYea r := 0;
  1293         FMon th := 0;
  1294         FDay  := 0;
  1295         SetF MDate(Date Dialog.FMD ateTime);
  1296       end
  1297       else
  1298       begin
  1299         SetY ear(yy);
  1300         SetM onth(mm);
  1301         SetD ay(dd);
  1302       end;
  1303     finally
  1304       DateDi alog.Free;
  1305     end;
  1306   end;
  1307  
  1308   procedure  TORDateCom bo.YearUDC hange(Send er: TObjec t; var All owChange:  Boolean;
  1309   // 2FA                                        NewValue : Smallint ; Directio n: TUpDown Direction) ;
  1310                                          NewV alue: Inte ger; Direc tion: TUpD ownDirecti on);
  1311   var
  1312     y, m, d:  word;
  1313  
  1314   begin
  1315     if FYear Changing t hen exit;
  1316     FYearCha nging := T RUE;
  1317     try
  1318       if FYe arUD.Posit ion = (Fir stYear-1)  then
  1319       begin
  1320         Deco deDate(Now , y, m, d) ;
  1321         FYea r := y;
  1322         FYea rUD.Positi on := y;
  1323         Allo wChange :=  FALSE;
  1324       end
  1325       else
  1326         FYea r := NewVa lue;
  1327       if(FYe ar < First Year) or ( FYear > La stYear) th en
  1328         FYea r := 0;
  1329       if(FYe ar = 0) th en
  1330         FYea rEdit.Text  := '    '
  1331       else
  1332         FYea rEdit.Text  := IntToS tr(FYear);
  1333       if(FMo nth = 2) t hen
  1334         Init Days(FALSE );
  1335       CheckD ays;
  1336       DoChan ge;
  1337     finally
  1338       FYearC hanging :=  FALSE;
  1339     end;
  1340   end;
  1341  
  1342   procedure  TORDateCom bo.YearKey Press(Send er: TObjec t; var Key : Char);
  1343   begin
  1344     if(Key i n ['0'..'9 ']) and (F YearEdit.T ext = '     ') then
  1345     begin
  1346       FYearE dit.Text : = Key + '    ';
  1347       Key :=  #0;
  1348       FYearE dit.SelSta rt := 1;
  1349       FYearE dit.SelTex t := '';
  1350     end;
  1351   end;
  1352  
  1353   function T ORDateComb o.GetFMDat e: TFMDate Time;
  1354   begin
  1355     if(FYear  < FirstYe ar) then
  1356       Result  := 0
  1357     else
  1358       Result  := ((FYea r - 1700)  * 10000 +  FMonth * 1 00 + FDay) ;
  1359   end;
  1360  
  1361   procedure  TORDateCom bo.SetFMDa te(const V alue: TFMD ateTime);
  1362   var
  1363     ival, mo , dy: inte ger;
  1364                  
  1365   begin
  1366     if(Value  = 0) then
  1367     begin
  1368       SetYea r(0);
  1369       SetMon th(0);
  1370     end
  1371     else
  1372     begin
  1373       ival : = trunc(Va lue);
  1374       if(len gth(inttos tr(ival))  <> 7) then
  1375         exit ;
  1376       dy :=  (ival mod  100);
  1377       ival : = ival div  100;
  1378       mo :=  ival mod 1 00;
  1379       ival : = ival div  100;
  1380       SetYea r(ival + 1 700);
  1381       SetMon th(mo);
  1382       InitDa ys(FALSE);
  1383       SetDay (dy);
  1384     end;
  1385   end;
  1386  
  1387   function T ORDateComb o.DateText : string;
  1388   begin
  1389     Result : = '';
  1390     if(FYear  > 0) then
  1391     begin
  1392       if(FMo nth > 0) t hen
  1393       begin
  1394         if F LongMonths  then
  1395           Re sult := Fo rmatSettin gs.LongMon thNames[FM onth] //2F A
  1396         else
  1397           Re sult := Fo rmatSettin gs.ShortMo nthNames[F Month]; //  2FA
  1398         if(F Day > 0) t hen
  1399           Re sult := Re sult + ' '  + IntToSt r(FDay);
  1400         Resu lt := Resu lt + ', ';
  1401       end;
  1402       Result  := Result  + IntToSt r(FYear);
  1403     end;
  1404   end;
  1405  
  1406   procedure  TORDateCom bo.DoChang e;
  1407   begin
  1408     if assig ned(FOnCha nge) then
  1409       FOnCha nge(Self);
  1410   end;
  1411  
  1412   procedure  TORDateCom bo.Resized (Sender: T Object);
  1413   begin
  1414     Rebuild;
  1415   end;
  1416  
  1417   procedure  TORDateCom bo.CMFontC hanged(var  Message:  TMessage);
  1418   begin
  1419     inherite d;
  1420     Rebuild;
  1421   end;
  1422  
  1423   function T ORDateComb o.Text: st ring;
  1424   var
  1425     tmp, fmt , m: strin g;
  1426  
  1427   begin
  1428     Result : = '';
  1429     tmp := F loatToStr( FMDate);
  1430     if(tmp < > '') and  (tmp <> '0 ') and (le ngth(Tmp)  >= 7) then
  1431     begin
  1432       if FLo ngMonths t hen
  1433         m :=  'mmmm'
  1434       else
  1435         m :=  'mmm';
  1436       if(cop y(tmp,4,4)  = '0000')  then
  1437         fmt  := 'yyyy'
  1438       else
  1439       if(cop y(tmp,6,2)  = '00') t hen
  1440         fmt  := m + ',  YYYY'
  1441       else
  1442         fmt  := m + ' D , YYYY';
  1443       Result  := Format FMDateTime Str(fmt, t mp)
  1444     end;
  1445   end;
  1446  
  1447  
  1448   procedure  Register;
  1449   { used by  Delphi to  put compon ents on th e Palette  }
  1450   begin
  1451     Register Components ('CPRS', [ TORDateTim eDlg, TORD ateBox, TO RDateCombo ]);
  1452   end;
  1453  
  1454   procedure  TORDateCom bo.SetTemp lateField( const Valu e: boolean );
  1455   begin
  1456     if FTemp lateField  <> Value t hen
  1457     begin
  1458       FTempl ateField : = Value;
  1459       Rebuil d;
  1460     end;
  1461   end;
  1462  
  1463   initializa tion
  1464     uServerT oday := 0;
  1465  
  1466   end.