Produced by Araxis Merge on 1/9/2019 7:03:18 AM Central Standard 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.
| # | Location | File | Last Modified |
|---|---|---|---|
| 1 | OR_30_405V55_SRC.zip\OR_30_405V55_SRC\10_2\OR\Source | ORDtTm.pas | Wed Sep 26 18:05:56 2018 UTC |
| 2 | OR_30_405V55_SRC.zip\OR_30_405V55_SRC\10_2\OR\Source | ORDtTm.pas | Tue Jan 8 17:50:48 2019 UTC |
| Description | Between Files 1 and 2 |
|
|---|---|---|
| Text Blocks | Lines | |
| Unchanged | 2 | 4310 |
| Changed | 1 | 2 |
| Inserted | 0 | 0 |
| Removed | 0 | 0 |
| 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 |
No regular expressions were active.
| 1 | unit ORDtT m; | |
| 2 | ||
| 3 | {$O-} | |
| 4 | ||
| 5 | interface | |
| 6 | ||
| 7 | uses | |
| 8 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dia logs, | |
| 9 | StdCtrls , Buttons, | |
| 10 | Grids, C alendar, E xtCtrls, O RFn, ORNet , ORDtTmCa l, Mask, C omCtrls, | |
| 11 | OR2006Co mpatibilit y, | |
| 12 | ORCtrls, VAClasses , VA508Acc essibility Manager, V A508Access ibilityRou ter, | |
| 13 | DateUtil s, Math, O RDtTmListB ox; | |
| 14 | ||
| 15 | type | |
| 16 | ||
| 17 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- ------ Beg in | |
| 18 | TDateRan ge = class (TObject) | |
| 19 | private | |
| 20 | fMinDa te: Double ; | |
| 21 | fMaxDa te: Double ; | |
| 22 | proced ure SetMin Date(Const aMinDte: Double); | |
| 23 | proced ure SetMax Date(const aMaxDte: Double); | |
| 24 | public | |
| 25 | proper ty MaxDate : Double r ead fMaxDa te write S etMaxDate; | |
| 26 | proper ty MinDate : Double r ead fMinDa te write S etMinDate; | |
| 27 | functi on IsBetwe enMinAndMa x(const Lo okupDate: TDateTime) : Boolean; | |
| 28 | functi on IsFullD ay(const a Date: TDat eTime): Bo olean; | |
| 29 | constr uctor Crea te; | |
| 30 | end; | |
| 31 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- -------- E nd | |
| 32 | ||
| 33 | TORCalen dar = clas s(ORDtTmCa l.TORCalen dar) // CP RSPackages .ORDtTmCal | |
| 34 | private | |
| 35 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
| 36 | fValid Range: TDa teRange; | |
| 37 | proced ure SetVal idRange(aR ange: TDat eRange); | |
| 38 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
| 39 | functi on IsBetwe enMinAndMa x(const Lo okupDate: TDateTime) : Boolean; | |
| 40 | ||
| 41 | functi on getMinD ateTime: T DateTime; | |
| 42 | functi on getMaxD ateTime: T DateTime; | |
| 43 | functi on isRange Mode: bool ean; | |
| 44 | public | |
| 45 | constr uctor Crea te(AOwner: TComponen t); overri de; | |
| 46 | // con structor C reateByRan ge(AOwner: TComponen t;aDateRan ge:TDateRa nge); | |
| 47 | ||
| 48 | destru ctor Destr oy(); over ride; | |
| 49 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
| 50 | proper ty ValidRa nge: TDate Range read fValidRan ge write S etValidRan ge; | |
| 51 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
| 52 | proper ty MinDate Time: TDat eTime read getMinDat eTime; | |
| 53 | proper ty MaxDate Time: TDat eTime read getMaxDat eTime; | |
| 54 | protecte d | |
| 55 | proced ure KeyDow n(var Key: Word; Shi ft: TShift State); ov erride; | |
| 56 | functi on SelectC ell(ACol, ARow: Long int): Bool ean; overr ide; | |
| 57 | proced ure DrawCe ll(ACol, A Row: Longi nt; ARect: TRect; | |
| 58 | ASta te: TGridD rawState); override; | |
| 59 | end; | |
| 60 | ||
| 61 | TORfrmDt Tm = class (Tfrm2006C ompatibili ty) | |
| 62 | VA508A ccessibili tyManager1 : TVA508Ac cessibilit yManager; | |
| 63 | TxtDat eSelected: TLabel; | |
| 64 | Label1 : TLabel; | |
| 65 | bvlFra me: TBevel ; | |
| 66 | pnlDat e: TPanel; | |
| 67 | txtTim e: TEdit; | |
| 68 | lstHou r: TORDtTm ListBox; | |
| 69 | lstMin ute: TORDt TmListBox; | |
| 70 | cmdOK: TButton; | |
| 71 | cmdCan cel: TButt on; | |
| 72 | calSel ect: TORCa lendar; | |
| 73 | cmdTod ay: TButto n; | |
| 74 | cmdNow : TButton; | |
| 75 | cmdMid night: TBu tton; | |
| 76 | bbtnPr evMonth: T BitBtn; | |
| 77 | bbtnNe xtMonth: T BitBtn; | |
| 78 | proced ure FormCr eate(Sende r: TObject ); | |
| 79 | proced ure calSel ectChange( Sender: TO bject); | |
| 80 | proced ure cmdTod ayClick(Se nder: TObj ect); | |
| 81 | proced ure txtTim eChange(Se nder: TObj ect); | |
| 82 | proced ure lstHou rClick(Sen der: TObje ct); | |
| 83 | proced ure lstMin uteClick(S ender: TOb ject); | |
| 84 | proced ure cmdNow Click(Send er: TObjec t); | |
| 85 | proced ure cmdOKC lick(Sende r: TObject ); | |
| 86 | proced ure cmdCan celClick(S ender: TOb ject); | |
| 87 | proced ure cmdMid nightClick (Sender: T Object); | |
| 88 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
| 89 | proced ure FormKe yDown(Send er: TObjec t; var Key : Word; Sh ift: TShif tState); | |
| 90 | proced ure lstHou rEnter(Sen der: TObje ct); | |
| 91 | proced ure bbtnPr evMonthCli ck(Sender: TObject); | |
| 92 | proced ure bbtnNe xtMonthCli ck(Sender: TObject); | |
| 93 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
| 94 | private | |
| 95 | FFromS elf: Boole an; | |
| 96 | FNowPr essed: Boo lean; | |
| 97 | TimeIs Required: Boolean; | |
| 98 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
| 99 | proced ure setTim eListsBySe lectedDate ; | |
| 100 | proced ure setRan geTimeBoun daries; | |
| 101 | proced ure setBut tonStatus; | |
| 102 | functi on TimeIsV alid: Bool ean; | |
| 103 | functi on IsRange Mode: Bool ean; | |
| 104 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
| 105 | protecte d | |
| 106 | proced ure Loaded ; override ; | |
| 107 | end; | |
| 108 | ||
| 109 | { TORDat eTimeDlg } | |
| 110 | ||
| 111 | TORDateT imeDlg = c lass(TComp onent) | |
| 112 | private | |
| 113 | FDateT ime: TDate Time; | |
| 114 | FDateO nly: Boole an; | |
| 115 | FRequi reTime: Bo olean; | |
| 116 | FRelat iveTime: s tring; | |
| 117 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
| 118 | fDateR ange: TDat eRange; | |
| 119 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
| 120 | functi on GetFMDa teTime: TF MDateTime; | |
| 121 | proced ure SetDat eOnly(Valu e: Boolean ); | |
| 122 | proced ure SetFMD ateTime(Va lue: TFMDa teTime); | |
| 123 | proced ure SetReq uireTime(V alue: Bool ean); | |
| 124 | public | |
| 125 | constr uctor Crea te(AOwner: TComponen t); overri de; | |
| 126 | functi on Execute : Boolean; | |
| 127 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
| 128 | proper ty DateRan ge: TDateR ange read fDateRange write fDa teRange; | |
| 129 | proper ty DateTim e: TDateTi me read FD ateTime wr ite FDateT ime; | |
| 130 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
| 131 | proper ty Relativ eTime: str ing read F RelativeTi me; | |
| 132 | publishe d | |
| 133 | proper ty FMDateT ime: TFMDa teTime rea d GetFMDat eTime writ e SetFMDat eTime; | |
| 134 | proper ty DateOnl y: Boolean read FDat eOnly writ e SetDateO nly; | |
| 135 | proper ty Require Time: Bool ean read F RequireTim e write Se tRequireTi me; | |
| 136 | end; | |
| 137 | ||
| 138 | // 508 c lass | |
| 139 | TORDateB utton = cl ass(TBitBt n); | |
| 140 | ||
| 141 | { TORDat eBox } | |
| 142 | ||
| 143 | TORDateE dit = clas s(TEdit) | |
| 144 | protecte d | |
| 145 | proced ure Create Params(var Params: T CreatePara ms); overr ide; | |
| 146 | end; | |
| 147 | ||
| 148 | TORDateB ox = class (TORDateEd it, IVADyn amicProper ty, | |
| 149 | IORBla ckColorMod eCompatibl e) | |
| 150 | private | |
| 151 | FFMDat eTime: TFM DateTime; | |
| 152 | FDateO nly: Boole an; | |
| 153 | FRequi reTime: Bo olean; | |
| 154 | FButto n: TORDate Button; | |
| 155 | FForma t: string; | |
| 156 | FTimeI sNow: Bool ean; | |
| 157 | FTempl ateField: Boolean; | |
| 158 | FCapti on: TStati cText; | |
| 159 | FBlack ColorMode: Boolean; | |
| 160 | FOnDat eDialogClo sed: TNoti fyEvent; | |
| 161 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
| 162 | fDateS elected: T DateTime; | |
| 163 | fDateR ange: TDat eRange; | |
| 164 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
| 165 | proced ure Button Click(Send er: TObjec t); | |
| 166 | functi on GetFMDa teTime: TF MDateTime; | |
| 167 | functi on GetRela tiveTime: string; | |
| 168 | proced ure SetDat eOnly(Valu e: Boolean ); | |
| 169 | proced ure SetFMD ateTime(Va lue: TFMDa teTime); | |
| 170 | proced ure SetEdi tRect; | |
| 171 | proced ure SetReq uireTime(V alue: Bool ean); | |
| 172 | proced ure Update Text; | |
| 173 | proced ure WMSize (var Messa ge: TWMSiz e); messag e WM_SIZE; | |
| 174 | proced ure SetTem plateField (const Val ue: Boolea n); | |
| 175 | proced ure SetCap tion(const Value: st ring); | |
| 176 | functi on GetCapt ion(): str ing; | |
| 177 | protecte d | |
| 178 | proced ure Change ; override ; | |
| 179 | proced ure KeyPre ss(var Key : Char); o verride; | |
| 180 | proced ure KeyDow n(var Key: Word; Shi ft: TShift State); ov erride; | |
| 181 | proper ty DateBut ton: TORDa teButton r ead FButto n; | |
| 182 | proced ure SetEna bled(Value : Boolean) ; override ; | |
| 183 | // wat v28 when disabling TORDateBo x, button still appe ars active , this add resses tha t | |
| 184 | public | |
| 185 | constr uctor Crea te(AOwner: TComponen t); overri de; | |
| 186 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
| 187 | destru ctor Destr oy(); over ride; | |
| 188 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
| 189 | functi on IsValid : Boolean; | |
| 190 | proced ure Valida te(var Err Msg: strin g); | |
| 191 | proced ure SetBla ckColorMod e(Value: B oolean); | |
| 192 | functi on Support sDynamicPr operty(Pro pertyID: I nteger): B oolean; | |
| 193 | functi on GetDyna micPropert y(Property ID: Intege r): string ; | |
| 194 | proper ty Format: string re ad FFormat write FFo rmat; | |
| 195 | proper ty Relativ eTime: str ing read G etRelative Time; | |
| 196 | proper ty Templat eField: Bo olean read FTemplate Field writ e SetTempl ateField; | |
| 197 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
| 198 | proper ty DateSel ected: TDa teTime rea d fDateSel ected writ e fDateSel ected; | |
| 199 | proper ty DateRan ge: TDateR ange read fDateRange write fDa teRange; | |
| 200 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
| 201 | publishe d | |
| 202 | proper ty FMDateT ime: TFMDa teTime rea d GetFMDat eTime writ e SetFMDat eTime; | |
| 203 | proper ty DateOnl y: Boolean read FDat eOnly writ e SetDateO nly; | |
| 204 | proper ty Require Time: Bool ean read F RequireTim e write Se tRequireTi me; | |
| 205 | proper ty Caption : string r ead GetCap tion write SetCaptio n; | |
| 206 | proper ty OnDateD ialogClose d: TNotify Event read FOnDateDi alogClosed | |
| 207 | writ e FOnDateD ialogClose d; | |
| 208 | end; | |
| 209 | ||
| 210 | // 508 c lasses | |
| 211 | TORDayCo mbo = clas s(TORCombo Box); | |
| 212 | TORMonth Combo = cl ass(TORCom boBox); | |
| 213 | ||
| 214 | TORYearE dit = clas s(TMaskEdi t) | |
| 215 | private | |
| 216 | FTempl ateField: Boolean; | |
| 217 | proced ure SetTem plateField (const Val ue: Boolea n); | |
| 218 | protecte d | |
| 219 | proper ty Templat eField: Bo olean read FTemplate Field writ e SetTempl ateField; | |
| 220 | end; | |
| 221 | ||
| 222 | TORYearE ditClass = Class of TORYearEdi t; | |
| 223 | ||
| 224 | TORDateC ombo = cla ss(TCustom Panel, IOR BlackColor ModeCompat ible) | |
| 225 | private | |
| 226 | FYearC hanging: B oolean; | |
| 227 | FMonth Combo: TOR MonthCombo ; | |
| 228 | FDayCo mbo: TORDa yCombo; | |
| 229 | FYearE dit: TORYe arEdit; | |
| 230 | FYearU D: TUpDown ; | |
| 231 | FCalBt n: TORDate Button; | |
| 232 | FInclu deMonth: B oolean; | |
| 233 | FInclu deDay: Boo lean; | |
| 234 | FInclu deBtn: Boo lean; | |
| 235 | FLongM onths: Boo lean; | |
| 236 | FMonth : Integer; | |
| 237 | FDay: Integer; | |
| 238 | FYear: Integer; | |
| 239 | FCtrls Created: B oolean; | |
| 240 | FOnCha nge: TNoti fyEvent; | |
| 241 | FRebui lding: Boo lean; | |
| 242 | FTempl ateField: Boolean; | |
| 243 | FBlack ColorMode: Boolean; | |
| 244 | FORYea rEditClass : TORYearE ditClass; | |
| 245 | fColor : TColor; // NSR2007 1216 AA 20 16-01-22 | |
| 246 | proced ure SetCol or(const V alue: TCol or); // NS R20071216 AA 2016-01 -22 | |
| 247 | proced ure SetInc ludeBtn(co nst Value: Boolean); | |
| 248 | proced ure SetInc ludeDay(Va lue: Boole an); | |
| 249 | proced ure SetInc ludeMonth( const Valu e: Boolean ); | |
| 250 | proced ure SetLon gMonths(co nst Value: Boolean); | |
| 251 | proced ure SetDay (Value: In teger); | |
| 252 | proced ure SetMon th(Value: Integer); | |
| 253 | proced ure SetYea r(const Va lue: Integ er); | |
| 254 | functi on GetFMDa te: TFMDat eTime; | |
| 255 | proced ure SetFMD ate(const Value: TFM DateTime); | |
| 256 | proced ure CMFont Changed(va r Message: TMessage) ; message CM_FONTCHA NGED; | |
| 257 | proced ure SetTem plateField (const Val ue: Boolea n); | |
| 258 | protecte d | |
| 259 | proced ure Rebuil d; virtual ; | |
| 260 | functi on InitDay s(GetSize: Boolean): Integer; | |
| 261 | functi on InitMon ths(GetSiz e: Boolean ): Integer ; | |
| 262 | functi on GetYear Size: Inte ger; | |
| 263 | proced ure DoChan ge; | |
| 264 | proced ure MonthC hanged(Sen der: TObje ct); | |
| 265 | proced ure DayCha nged(Sende r: TObject ); | |
| 266 | proced ure YearCh anged(Send er: TObjec t); | |
| 267 | proced ure BtnCli cked(Sende r: TObject ); | |
| 268 | {XE8 r equires in teger, XE3 required SmallInt} | |
| 269 | proced ure YearUD Change(Sen der: TObje ct; var Al lowChange: Boolean; NewValue: Integer; D irection: TUpDownDir ection); | |
| 270 | proced ure YearKe yPress(Sen der: TObje ct; var Ke y: Char); | |
| 271 | proced ure CheckD ays; | |
| 272 | proced ure Loaded ; override ; | |
| 273 | proced ure Paint; override; | |
| 274 | proced ure Resize d(Sender: TObject); | |
| 275 | proper ty MonthCo mbo: TORMo nthCombo r ead FMonth Combo; | |
| 276 | proper ty DayComb o: TORDayC ombo read FDayCombo; | |
| 277 | proper ty YearEdi t: TORYear Edit read FYearEdit; | |
| 278 | proper ty YearUD: TUpDown r ead FYearU D; | |
| 279 | proper ty CalBtn: TORDateBu tton read FCalBtn; | |
| 280 | proper ty ORYearE ditClass: TORYearEdi tClass rea d FORYearE ditClass | |
| 281 | writ e FORYearE ditClass; | |
| 282 | public | |
| 283 | constr uctor Crea te(AOwner: TComponen t); overri de; | |
| 284 | destru ctor Destr oy; overri de; | |
| 285 | functi on DateTex t: string; | |
| 286 | proced ure SetBla ckColorMod e(Value: B oolean); | |
| 287 | proper ty Templat eField: Bo olean read FTemplate Field writ e SetTempl ateField; | |
| 288 | proper ty FMDate: TFMDateTi me read Ge tFMDate wr ite SetFMD ate; | |
| 289 | publishe d | |
| 290 | functi on Text: s tring; | |
| 291 | proper ty Include Btn: Boole an read FI ncludeBtn write SetI ncludeBtn; | |
| 292 | proper ty Include Day: Boole an read FI ncludeDay write SetI ncludeDay; | |
| 293 | proper ty Include Month: Boo lean read FIncludeMo nth write SetInclude Month; | |
| 294 | proper ty LongMon ths: Boole an read FL ongMonths write SetL ongMonths | |
| 295 | defa ult False; | |
| 296 | proper ty Month: Integer re ad FMonth write SetM onth; | |
| 297 | proper ty Day: In teger read FDay writ e SetDay; | |
| 298 | proper ty Year: I nteger rea d FYear wr ite SetYea r; | |
| 299 | proper ty OnChang e: TNotify Event read FOnChange write FOn Change; | |
| 300 | proper ty Color: TColor rea d fColor w rite SetCo lor; // NS R20071216 | |
| 301 | proper ty Anchors ; | |
| 302 | proper ty Enabled ; | |
| 303 | proper ty Font; | |
| 304 | proper ty ParentC olor; | |
| 305 | proper ty ParentF ont; | |
| 306 | proper ty TabOrde r; | |
| 307 | proper ty TabStop ; | |
| 308 | proper ty Visible ; | |
| 309 | end; | |
| 310 | ||
| 311 | function I sLeapYear( AYear: Int eger): Boo lean; | |
| 312 | function D aysPerMont h(AYear, A Month: Int eger): Int eger; | |
| 313 | function S erverFMNow : TFMDateT ime; | |
| 314 | function S erverParse FMDate(con st AString : string): TFMDateTi me; | |
| 315 | function S erverToday : TDateTim e; | |
| 316 | ||
| 317 | procedure Register; | |
| 318 | ||
| 319 | implementa tion | |
| 320 | ||
| 321 | uses | |
| 322 | System.U ITypes; | |
| 323 | ||
| 324 | {$R *.DFM} | |
| 325 | {$R ORDtTm } | |
| 326 | ||
| 327 | const | |
| 328 | FMT_DATE TIME = 'mm m d,yyyy@h h:nn'; | |
| 329 | FMT_DATE ONLY = 'mm m d,yyyy'; | |
| 330 | AdjVertS ize = 8; | |
| 331 | FontHeig htText = ' BEFHILMSTV WXZfgjmpqt yk'; | |
| 332 | ||
| 333 | var | |
| 334 | uServerT oday: TFMD ateTime; | |
| 335 | FormatSe ttings: TF ormatSetti ngs; | |
| 336 | ||
| 337 | { Server -dependent functions --------- ---------- ---------- ---------- ---------- ---------- ----- } | |
| 338 | ||
| 339 | function A ctiveBroke r: Boolean ; | |
| 340 | begin | |
| 341 | Result : = False; | |
| 342 | if (RPCB rokerV <> nil) and R PCBrokerV. Connected then | |
| 343 | Result := True; | |
| 344 | end; | |
| 345 | ||
| 346 | function S erverFMNow : TFMDateT ime; | |
| 347 | var | |
| 348 | aStr: st ring; | |
| 349 | begin | |
| 350 | if Activ eBroker th en | |
| 351 | begin | |
| 352 | Call VistA('ORW U DT', ['N OW'], aStr ); | |
| 353 | Resu lt := StrT oFloat(aSt r); | |
| 354 | end | |
| 355 | else | |
| 356 | Result := DateTi meToFMDate Time(Now); | |
| 357 | end; | |
| 358 | ||
| 359 | function S erverNow: TDateTime; | |
| 360 | begin | |
| 361 | if Activ eBroker th en | |
| 362 | Result := FMDate TimeToDate Time(Serve rFMNow) | |
| 363 | else | |
| 364 | Result := Now; | |
| 365 | end; | |
| 366 | ||
| 367 | function S erverToday : TDateTim e; | |
| 368 | begin | |
| 369 | if uServ erToday = 0 then | |
| 370 | uServe rToday := Int(Server FMNow); | |
| 371 | Result : = FMDateTi meToDateTi me(uServer Today); | |
| 372 | end; | |
| 373 | ||
| 374 | function S erverParse FMDate(con st AString : string): TFMDateTi me; | |
| 375 | var | |
| 376 | aStr: st ring; | |
| 377 | begin | |
| 378 | if Activ eBroker th en | |
| 379 | begin | |
| 380 | Call VistA('ORW U DT', [AS tring, 'TS X'], aStr) ; | |
| 381 | Resu lt := StrT oFloat(aSt r); | |
| 382 | end | |
| 383 | else Res ult := 0; | |
| 384 | end; | |
| 385 | ||
| 386 | function R elativeDat eTime(ADat eTime: TDa teTime): s tring; | |
| 387 | var | |
| 388 | Offset: Integer; | |
| 389 | h, n, s, l: Word; | |
| 390 | ATime: s tring; | |
| 391 | begin | |
| 392 | Offset : = Trunc(In t(aDateTim e) - Int(S erverToday )); | |
| 393 | if Offse t < 0 then | |
| 394 | Result := 'T' + IntToStr(O ffset) | |
| 395 | else if Offset = 0 then | |
| 396 | Result := 'T' | |
| 397 | else | |
| 398 | Result := 'T+' + IntToStr( Offset); | |
| 399 | DecodeTi me(aDateTi me, h, n, s, l); | |
| 400 | ATime := Format('@ %.2d:%.2d' , [h, n]); | |
| 401 | if ATime <> '@00:0 0' then | |
| 402 | Result := Result + ATime; | |
| 403 | end; | |
| 404 | ||
| 405 | procedure LoadEllips is(bitmap: TBitMap; BlackColor Mode: Bool ean); | |
| 406 | var | |
| 407 | ResName: string; | |
| 408 | begin | |
| 409 | if Black ColorMode then | |
| 410 | ResNam e := 'BLAC K_BMP_ELLI PSIS' | |
| 411 | else | |
| 412 | ResNam e := 'BMP_ ELLIPSIS'; | |
| 413 | bitmap.L oadFromRes ourceName( hInstance, ResName); | |
| 414 | end; | |
| 415 | ||
| 416 | /// ////// ////////// ////////// ////////// ////////// ////////// ////////// ////////// / | |
| 417 | function s tripCharSe t(AString: String; a Set: TSysC harSet): S tring; | |
| 418 | var | |
| 419 | i: Integ er; | |
| 420 | begin | |
| 421 | Result : = AString; | |
| 422 | for i := Length(Re sult) down to 1 do | |
| 423 | if not CharInSet (Result[i] , aSet) th en | |
| 424 | Dele te(Result, i, 1); | |
| 425 | end; | |
| 426 | ||
| 427 | function s tripChars( AString: S tring): St ring; | |
| 428 | begin | |
| 429 | Result : = stripCha rSet(AStri ng, ['0' . . '9']); | |
| 430 | end; | |
| 431 | ||
| 432 | { TfrmORDt Tm ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- --- } | |
| 433 | ||
| 434 | procedure TORfrmDtTm .FormCreat e(Sender: TObject); | |
| 435 | begin | |
| 436 | ResizeAn choredForm ToFont(sel f); | |
| 437 | lstHour. TopIndex : = 6; | |
| 438 | FFromSel f := False ; | |
| 439 | if Scree nReaderSys temActive then | |
| 440 | GetScr eenReader. Speak(Labe l1.Caption ); | |
| 441 | end; | |
| 442 | ||
| 443 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ---- Begin | |
| 444 | procedure TORfrmDtTm .FormKeyDo wn(Sender: TObject; var Key: W ord; | |
| 445 | Shift: T ShiftState ); | |
| 446 | begin | |
| 447 | if Key = VK_ESCAPE then | |
| 448 | ModalR esult := m rCancel; | |
| 449 | end; | |
| 450 | ||
| 451 | procedure TORfrmDtTm .setTimeLi stsBySelec tedDate; | |
| 452 | begin | |
| 453 | lstHour. MinTime := -1; | |
| 454 | lstHour. MaxTime := -1; | |
| 455 | lstMinut e.MinTime := -1; | |
| 456 | lstMinut e.MaxTime := -1; | |
| 457 | // Check for Min a nd Max of calendar | |
| 458 | if DateO f(calSelec t.Calendar Date) <= D ateOf(calS elect.MinD ateTime) t hen | |
| 459 | begin | |
| 460 | lstHou r.MinTime := HourOf( calSelect. MinDateTim e); | |
| 461 | lstMin ute.MinTim e := Minut eOf(calSel ect.MinDat eTime); | |
| 462 | if Tim eOf(calSel ect.Calend arDate) < calSelect. MinDateTim e then | |
| 463 | begin | |
| 464 | lstH our.ItemIn dex := Hou rOf(calSel ect.MinDat eTime); | |
| 465 | lstM inute.Item Index := M inuteOf(ca lSelect.Mi nDateTime) div 5; | |
| 466 | end; | |
| 467 | end | |
| 468 | else if DateOf(cal Select.Cal endarDate) >= DateOf (calSelect .MaxDateTi me) then | |
| 469 | begin | |
| 470 | lstHou r.MaxTime := HourOf( calSelect. MaxDateTim e); | |
| 471 | lstMin ute.MaxTim e := Minut eOf(calSel ect.MaxDat eTime); | |
| 472 | if Tim eOf(calSel ect.Calend arDate) > calSelect. MaxDateTim e then | |
| 473 | begin | |
| 474 | lstH our.ItemIn dex := Hou rOf(calSel ect.MaxDat eTime); | |
| 475 | lstM inute.Item Index := M inuteOf(ca lSelect.Mi nDateTime) div 5; | |
| 476 | end; | |
| 477 | end | |
| 478 | else // Date withi n range | |
| 479 | begin | |
| 480 | lstHou r.ItemInde x := 6; | |
| 481 | lstMin ute.ItemIn dex := 0; | |
| 482 | end; | |
| 483 | lstHour. Repaint; | |
| 484 | lstMinut e.Repaint; | |
| 485 | end; | |
| 486 | ||
| 487 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ------ End | |
| 488 | function T ORfrmDtTm. IsRangeMod e: Boolean ; | |
| 489 | begin | |
| 490 | // fix for Defect #3 32950: | |
| 491 | // Access violation in TORDate Combo comp onent on s electing t he date in the assoc iated Cale ndar form | |
| 492 | Result : = calSelec t.isRangeM ode; | |
| 493 | end; | |
| 494 | ||
| 495 | procedure TORfrmDtTm .bbtnNextM onthClick( Sender: TO bject); | |
| 496 | begin | |
| 497 | inherite d; | |
| 498 | calSelec t.NextMont h; | |
| 499 | end; | |
| 500 | ||
| 501 | procedure TORfrmDtTm .bbtnPrevM onthClick( Sender: TO bject); | |
| 502 | begin | |
| 503 | inherite d; | |
| 504 | calSelec t.PrevMont h; | |
| 505 | end; | |
| 506 | ||
| 507 | procedure TORfrmDtTm .calSelect Change(Sen der: TObje ct); | |
| 508 | begin | |
| 509 | pnlDate. Caption := FormatDat eTime('mmm m d, yyyy' , calSelec t.Calendar Date); | |
| 510 | FNowPres sed := Fal se; | |
| 511 | if Scree nReaderSys temActive then | |
| 512 | begin | |
| 513 | // Txt DateSelect ed.Caption := lblDat e.Caption; | |
| 514 | TxtDat eSelected. Caption := Label1.Ca ption + ' ' + pnlDat e.Caption; | |
| 515 | GetScr eenReader. Speak(pnlD ate.Captio n); | |
| 516 | end; | |
| 517 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- ------ Beg in | |
| 518 | if IsRan geMode the n // check if the va lid range was set | |
| 519 | begin | |
| 520 | // Now need to e nforce inv alid times | |
| 521 | setTim eListsBySe lectedDate ; | |
| 522 | if Tim eIsRequire d then | |
| 523 | lstM inuteClick (nil); | |
| 524 | setBut tonStatus; | |
| 525 | end; | |
| 526 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- -------- E nd | |
| 527 | end; | |
| 528 | ||
| 529 | procedure TORfrmDtTm .cmdTodayC lick(Sende r: TObject ); | |
| 530 | begin | |
| 531 | calSelec t.Calendar Date := Se rverToday; | |
| 532 | ||
| 533 | // cmdTo day is dis abled if o ut of assi gned valid range | |
| 534 | if not I sRangeMode then | |
| 535 | begin | |
| 536 | lstHou r.ItemInde x := -1; | |
| 537 | lstMin ute.ItemIn dex := -1; | |
| 538 | txtTim e.Text := ''; | |
| 539 | end; | |
| 540 | end; | |
| 541 | ||
| 542 | procedure TORfrmDtTm .txtTimeCh ange(Sende r: TObject ); | |
| 543 | begin | |
| 544 | if not F FromSelf t hen | |
| 545 | begin | |
| 546 | lstHou r.ItemInde x := -1; | |
| 547 | lstMin ute.ItemIn dex := -1; | |
| 548 | end; | |
| 549 | FNowPres sed := Fal se; | |
| 550 | end; | |
| 551 | ||
| 552 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ---- Begin | |
| 553 | procedure TORfrmDtTm .setButton Status; | |
| 554 | var | |
| 555 | dt: TDat eTime; | |
| 556 | begin | |
| 557 | if IsRan geMode the n | |
| 558 | begin | |
| 559 | cmdNow .Enabled : = calSelec t.ValidRan ge.IsBetwe enMinAndMa x(Now); | |
| 560 | cmdTod ay.Enabled := calSel ect.ValidR ange.IsBet weenMinAnd Max(Server Today); | |
| 561 | dt := calSelect. CalendarDa te; | |
| 562 | cmdMid night.Enab led := cal Select.Val idRange.Is BetweenMin AndMax | |
| 563 | (rou nd(dt) + 1 - 1 / (24 * 60)); | |
| 564 | end; | |
| 565 | end; | |
| 566 | ||
| 567 | procedure TORfrmDtTm .setRangeT imeBoundar ies; | |
| 568 | var | |
| 569 | HourSel: String; | |
| 570 | begin | |
| 571 | // only in case th e valid ra nge is ass igned | |
| 572 | if (not assigned(c alSelect.V alidRange) ) or ( | |
| 573 | (calSele ct.ValidRa nge.MaxDat e = -1) an d (calSele ct.ValidRa nge.MinDat e = -1) | |
| 574 | ) | |
| 575 | then | |
| 576 | exit; | |
| 577 | ||
| 578 | // Need to set the min minut e | |
| 579 | lstMinut e.MinTime := -1; | |
| 580 | lstMinut e.MaxTime := -1; | |
| 581 | ||
| 582 | // Grab the hour s elected | |
| 583 | if lstHo ur.ItemInd ex < 0 the n | |
| 584 | HourSe l := '0' | |
| 585 | else | |
| 586 | HourSe l := strip Chars(lstH our.Items[ lstHour.It emIndex]); | |
| 587 | ||
| 588 | // Now n eed to enf orce inval id times | |
| 589 | if DateO f(calSelec t.Calendar Date) = Da teOf(calSe lect.MinDa teTime) th en | |
| 590 | begin // date is o n the rang e boundary | |
| 591 | if Str ToIntDef(H ourSel, -1 ) <= HourO f(calSelec t.MinDateT ime) then | |
| 592 | begin // reset m inutes of the bounda ry hour | |
| 593 | lstH our.ItemIn dex := Hou rOf(calSel ect.MinDat eTime); | |
| 594 | ||
| 595 | lstM inute.MinT ime := Min uteOf(calS elect.MinD ateTime); | |
| 596 | // c alculate m in index | |
| 597 | if ( lstMinute. ItemIndex = -1) // m inutes wer e not sele cted | |
| 598 | or (lstMinut e.ItemInde x < Minute Of(calSele ct.MinDate Time)) the n | |
| 599 | // assign mi n index if mot assig ned | |
| 600 | ls tMinute.It emIndex := MinuteOf( calSelect. MinDateTim e) | |
| 601 | end | |
| 602 | else | |
| 603 | // r eset minut es | |
| 604 | lstM inute.Item Index := 0 ; // -1; | |
| 605 | end | |
| 606 | else if DateOf(cal Select.Cal endarDate) = DateOf( calSelect. MaxDateTim e) then | |
| 607 | begin // date is o n the rang e boundary | |
| 608 | if Str ToIntDef(H ourSel, -1 ) >= HourO f(calSelec t.MaxDateT ime) then | |
| 609 | begin | |
| 610 | lstH our.ItemIn dex := Hou rOf(calSel ect.MaxDat eTime); | |
| 611 | ||
| 612 | lstM inute.MaxT ime := Min uteOf(calS elect.MaxD ateTime); | |
| 613 | // c alculate m in index | |
| 614 | if ( lstMinute. ItemIndex = -1) or | |
| 615 | (l stMinute.I temIndex > MinuteOf( calSelect. MinDateTim e)) then | |
| 616 | // assign mi n index if mot assig ned | |
| 617 | ls tMinute.Ma xTime := M inuteOf(ca lSelect.Ma xDateTime) ; | |
| 618 | end | |
| 619 | else | |
| 620 | // r eset minut es | |
| 621 | lstM inute.Item Index := 0 ; // was - 1; | |
| 622 | end; | |
| 623 | lstMinut e.Repaint; | |
| 624 | end; | |
| 625 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ------ End | |
| 626 | ||
| 627 | procedure TORfrmDtTm .lstHourCl ick(Sender : TObject) ; | |
| 628 | begin | |
| 629 | setRange TimeBounda ries; // N SR20071216 AA 2016-0 1-29 | |
| 630 | ||
| 631 | if lstHo ur.ItemInd ex = 0 the n | |
| 632 | lstMin ute.Items[ 0] := ':01 --' | |
| 633 | else | |
| 634 | lstMin ute.Items[ 0] := ':00 --'; // <------ NE W CODE | |
| 635 | lstMinut eClick(sel f); | |
| 636 | end; | |
| 637 | ||
| 638 | procedure TORfrmDtTm .lstHourEn ter(Sender : TObject) ; | |
| 639 | begin | |
| 640 | setRange TimeBounda ries; // N SR20071216 AA 2016-0 1-29 | |
| 641 | end; | |
| 642 | ||
| 643 | procedure TORfrmDtTm .lstMinute Click(Send er: TObjec t); | |
| 644 | var | |
| 645 | AnHour, AMinute: I nteger; | |
| 646 | begin | |
| 647 | if lstHo ur.ItemInd ex >= 0 th en | |
| 648 | begin | |
| 649 | AnHour := lstHou r.ItemInde x; | |
| 650 | if lst Minute.Ite mIndex >= 0 then | |
| 651 | AMin ute := lst Minute.Ite mIndex * 5 | |
| 652 | else | |
| 653 | AMin ute := 0; // NSR2007 1216 AA 20 16-01-29 | |
| 654 | if (An Hour = 0) and (AMinu te = 0) th en | |
| 655 | AMin ute := 1; // <------ -------- N EW CODE | |
| 656 | FFromS elf := Tru e; | |
| 657 | txtTim e.Text := Format('%. 2d:%.2d ', [AnHour, AMinute]); | |
| 658 | ||
| 659 | FFromS elf := Fal se; | |
| 660 | end; | |
| 661 | end; | |
| 662 | ||
| 663 | procedure TORfrmDtTm .cmdNowCli ck(Sender: TObject); | |
| 664 | begin | |
| 665 | calSelec t.Calendar Date := Se rverToday; | |
| 666 | txtTime. Text := Fo rmatDateTi me('hh:nn' , ServerNo w); // if ampm time | |
| 667 | ||
| 668 | lstHou r.ItemInde x := -1; | |
| 669 | lstMin ute.ItemIn dex := -1; | |
| 670 | ||
| 671 | FNowPres sed := Tru e; | |
| 672 | end; | |
| 673 | ||
| 674 | procedure TORfrmDtTm .cmdMidnig htClick(Se nder: TObj ect); | |
| 675 | begin | |
| 676 | txtTime. Text := '2 3:59'; // if militar y time | |
| 677 | ||
| 678 | lstHour. ItemIndex := -1; | |
| 679 | lstMinut e.ItemInde x := -1; | |
| 680 | end; | |
| 681 | ||
| 682 | function T ORfrmDtTm. TimeIsVali d: Boolean ; | |
| 683 | var | |
| 684 | dt: TDat eTime; | |
| 685 | tm: TDat eTime; | |
| 686 | const | |
| 687 | fmtOutOf Range = 'T ime entere d %s is ou tside of t he allowed range.' + CRLF + | |
| 688 | 'Pleas e enter a valid time .'; | |
| 689 | ||
| 690 | procedur e ReportEr ror(aSelec tion: Stri ng); | |
| 691 | begin | |
| 692 | InfoBo x(Format(f mtOutOfRan ge, [aSele ction]) | |
| 693 | {$IFDEF DE BUG} | |
| 694 | + CRLF + CRLF | |
| 695 | + 'Min date:time ' + Forma tDateTime( 'mm:dd:yyy y hh:nn',c alSelect.f ValidRange .MinDate) + CRLF | |
| 696 | + 'Max date:time ' + Forma tDateTime( 'mm:dd:yyy y hh:nn',c alSelect.f ValidRange .MaxDate) + CRLF | |
| 697 | {$ENDIF} | |
| 698 | , 'Inv alid Time' , MB_OK); | |
| 699 | end; | |
| 700 | ||
| 701 | begin | |
| 702 | if not T imeIsRequi red then | |
| 703 | Result := True | |
| 704 | else | |
| 705 | begin | |
| 706 | Resu lt := Fals e; | |
| 707 | if L ength(txtT ime.Text) > 0 then | |
| 708 | begi n | |
| 709 | tr y | |
| 710 | tm := strT oTime(txtT ime.Text); | |
| 711 | if IsRange Mode then | |
| 712 | begin | |
| 713 | dt := calSelect. CalendarDa te; | |
| 714 | dt := trunc(dt) + tm; | |
| 715 | if not calSelect .IsBetween MinAndMax( dt) then | |
| 716 | {$IF DEF DEBUG} | |
| 717 | Repo rtError(fo rmatDateTi me('dd-mm- yyyy hh:nn ',dt)) | |
| 718 | {$EL SE} | |
| 719 | Repo rtError(tx tTime.Text ) | |
| 720 | {$EN DIF} | |
| 721 | else | |
| 722 | Resu lt := True ; | |
| 723 | end | |
| 724 | else | |
| 725 | Result : = True; | |
| 726 | ex cept | |
| 727 | on EConver tError do | |
| 728 | ReportEr ror('Inval id Time st ring' + CR LF + 'Plea se enter a valid tim e'); | |
| 729 | en d; | |
| 730 | end | |
| 731 | else | |
| 732 | Re portError( 'Please en ter a vali d time'); | |
| 733 | end; | |
| 734 | end; | |
| 735 | ||
| 736 | procedure TORfrmDtTm .cmdOKClic k(Sender: TObject); | |
| 737 | var | |
| 738 | X: strin g; | |
| 739 | ||
| 740 | begin | |
| 741 | if not T imeIsRequi red then | |
| 742 | begin | |
| 743 | Moda lResult := mrOK; | |
| 744 | exit ; | |
| 745 | end; | |
| 746 | ||
| 747 | if TimeI sRequired and (Lengt h(txtTime. Text) = 0) then | |
| 748 | begin | |
| 749 | InfoBo x('An entr y for time is requir ed.', 'Mis sing Time' , MB_OK); | |
| 750 | exit; | |
| 751 | end; | |
| 752 | ||
| 753 | if Lengt h(txtTime. Text) > 0 then | |
| 754 | begin | |
| 755 | X := T rim(txtTim e.Text); | |
| 756 | if (X = '00:00') or (X = ' 0:00') or (X = '00:0 0:00') or (X = '0:00 :00') then | |
| 757 | X := '00:01'; // <------ - CHANGED CODE | |
| 758 | try | |
| 759 | StrT oTime(X); | |
| 760 | txtT ime.Text : = X; | |
| 761 | if T imeIsValid then // N SR20071216 AA 2016-0 1-29 | |
| 762 | Mo dalResult := mrOK; | |
| 763 | except | |
| 764 | on E ConvertErr or do | |
| 765 | In foBox('Inc orrect tim e value "' +X+'"', 'I nvalid Tim e value', MB_OK); | |
| 766 | end; | |
| 767 | end; | |
| 768 | end; | |
| 769 | ||
| 770 | procedure TORfrmDtTm .cmdCancel Click(Send er: TObjec t); | |
| 771 | begin | |
| 772 | ModalRes ult := mrC ancel; | |
| 773 | end; | |
| 774 | ||
| 775 | procedure TORfrmDtTm .Loaded; | |
| 776 | begin | |
| 777 | inherite d Loaded; | |
| 778 | UpdateCo lorsFor508 Compliance (self); | |
| 779 | end; | |
| 780 | ||
| 781 | { TORDateT imeDlg } | |
| 782 | ||
| 783 | constructo r TORDateT imeDlg.Cre ate(AOwner : TCompone nt); | |
| 784 | begin | |
| 785 | inherite d Create(A Owner); | |
| 786 | if not(c sDesigning in Compon entState) then | |
| 787 | FDateT ime := Ser verToday | |
| 788 | else | |
| 789 | FDateT ime := Sys Utils.Date ; | |
| 790 | end; | |
| 791 | ||
| 792 | function T ORDateTime Dlg.Execut e: Boolean ; | |
| 793 | const | |
| 794 | HORZ_SPA CING = 8; | |
| 795 | var | |
| 796 | frmDtTm: TORfrmDtT m; | |
| 797 | ||
| 798 | // NSR20 071216 AA 2016-01-29 --------- ---------- ---------- ---------- ------ Beg in | |
| 799 | procedur e setRange ; | |
| 800 | begin | |
| 801 | with f rmDtTm do | |
| 802 | begin | |
| 803 | if A ssigned(se lf.DateRan ge) then | |
| 804 | begi n | |
| 805 | if (self.Dat eRange.Min Date <> -1 ) or (self .DateRange .MaxDate < > -1) then | |
| 806 | Caption := Caption + ' between ' + Forma tDateTime( 'mmm dd,YY @hh:nn ', | |
| 807 | self.Dat eRange.Min Date) + ' and ' + | |
| 808 | FormatDa teTime('mm m dd,YY@hh :nn', self .DateRange .MaxDate); | |
| 809 | ca lSelect.Va lidRange : = self.Dat eRange; | |
| 810 | ca lSelect.Ca lendarDate := self.D ateTime; | |
| 811 | se tButtonSta tus; | |
| 812 | end; | |
| 813 | end; | |
| 814 | end; | |
| 815 | // NSR2007 1216 AA 20 16-01-29 - ---------- ---------- ---------- ---------- ------ End | |
| 816 | ||
| 817 | begin | |
| 818 | frmDtTm := TORfrmD tTm.Create (Applicati on); | |
| 819 | try | |
| 820 | with f rmDtTm do | |
| 821 | begin | |
| 822 | pnlD ate.Captio n := Forma tDateTime( 'mmmm d, y yyy',FDate Time); | |
| 823 | setR ange; // N SR20071216 AA 2016-0 1-22 | |
| 824 | ||
| 825 | if F rac(FDateT ime) > 0 | |
| 826 | // t hen txtTim e.Text := FormatDate Time('h:nn ampm', FD ateTime); // if amp m time | |
| 827 | then | |
| 828 | tx tTime.Text := Format DateTime(' hh:nn', FD ateTime); // if mili tary time | |
| 829 | if R equireTime then | |
| 830 | Ti meIsRequir ed := True ; | |
| 831 | if D ateOnly th en | |
| 832 | begi n | |
| 833 | tx tTime.Visi ble := Fal se; | |
| 834 | ls tHour.Visi ble := Fal se; | |
| 835 | ls tMinute.Vi sible := F alse; | |
| 836 | cm dNow.Visib le := Fals e; | |
| 837 | cm dMidnight. Visible := False; | |
| 838 | bv lFrame.Wid th := bvlF rame.Width - txtTime .Width - H ORZ_SPACIN G; | |
| 839 | cm dOK.Left : = cmdOK.Le ft - txtTi me.Width - HORZ_SPAC ING; | |
| 840 | cm dCancel.Le ft := cmdO K.Left; | |
| 841 | Cl ientWidth := ClientW idth - txt Time.Width - HORZ_SP ACING; | |
| 842 | end; | |
| 843 | Resu lt := (Sho wModal = I DOK); | |
| 844 | if R esult then | |
| 845 | begi n | |
| 846 | FD ateTime := Int(calSe lect.Calen darDate); | |
| 847 | if Length(tx tTime.Text ) > 0 then | |
| 848 | FDateTime := FDateTi me + StrTo Time(txtTi me.Text); | |
| 849 | if FNowPress ed then | |
| 850 | FRelativeT ime := 'NO W' | |
| 851 | el se | |
| 852 | FRelativeT ime := Rel ativeDateT ime(FDateT ime); | |
| 853 | end; | |
| 854 | end; | |
| 855 | finally | |
| 856 | frmDtT m.Free; | |
| 857 | end; | |
| 858 | end; | |
| 859 | ||
| 860 | function T ORDateTime Dlg.GetFMD ateTime: T FMDateTime ; | |
| 861 | begin | |
| 862 | Result : = DateTime ToFMDateTi me(FDateTi me); | |
| 863 | end; | |
| 864 | ||
| 865 | procedure TORDateTim eDlg.SetDa teOnly(Val ue: Boolea n); | |
| 866 | begin | |
| 867 | FDateOnl y := Value ; | |
| 868 | if FDate Only then | |
| 869 | begin | |
| 870 | FRequi reTime := False; | |
| 871 | FDateT ime := Int (FDateTime ); | |
| 872 | end; | |
| 873 | end; | |
| 874 | ||
| 875 | procedure TORDateTim eDlg.SetFM DateTime(V alue: TFMD ateTime); | |
| 876 | begin | |
| 877 | if Value > 0 then | |
| 878 | FDateT ime := FMD ateTimeToD ateTime(Va lue); | |
| 879 | end; | |
| 880 | ||
| 881 | procedure TORDateTim eDlg.SetRe quireTime( Value: Boo lean); | |
| 882 | begin | |
| 883 | FRequire Time := Va lue; | |
| 884 | if FRequ ireTime th en | |
| 885 | FDateO nly := Fal se; | |
| 886 | end; | |
| 887 | ||
| 888 | { TORDateE dit ------ ---------- ---------- ---------- ---------- ---------- ---------- ---------- - } | |
| 889 | ||
| 890 | procedure TORDateEdi t.CreatePa rams(var P arams: TCr eateParams ); | |
| 891 | { sets a o ne line ed it box to multiline style so t he editing rectangle can be ch anged } | |
| 892 | begin | |
| 893 | inherite d CreatePa rams(Param s); | |
| 894 | Params.S tyle := Pa rams.Style or ES_MUL TILINE or WS_CLIPCHI LDREN; | |
| 895 | end; | |
| 896 | ||
| 897 | { TORDateB ox ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- --- } | |
| 898 | ||
| 899 | constructo r TORDateB ox.Create( AOwner: TC omponent); | |
| 900 | begin | |
| 901 | inherite d Create(A Owner); | |
| 902 | FButton := TORDate Button.Cre ate(self); | |
| 903 | FButton. Parent := self; | |
| 904 | FButton. Width := 1 8; | |
| 905 | FButton. Height := 17; | |
| 906 | FButton. OnClick := ButtonCli ck; | |
| 907 | // blj 1 9 Sept 201 7 JAZZ 329 927 - We h ave to be able to se t focus to the butto n using | |
| 908 | // Dragon bef ore we can pop the d ialog and worry abou t whether or not we can use | |
| 909 | // Dragon to move forwa rd or back wards a mo nth. | |
| 910 | FButton. TabStop := true; | |
| 911 | FBlackCo lorMode := False; | |
| 912 | LoadElli psis(FButt on.Glyph, False); | |
| 913 | FButton. Visible := True; | |
| 914 | FFormat := FMT_DAT ETIME; | |
| 915 | fDateRan ge := TDat eRange.Cre ate; // NS R20071216 AA 2016-01 -22 | |
| 916 | end; | |
| 917 | ||
| 918 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ---- Begin | |
| 919 | destructor TORDateBo x.Destroy( ); | |
| 920 | begin | |
| 921 | inherite d; | |
| 922 | fDateRan ge.Free; | |
| 923 | end; | |
| 924 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ------ End | |
| 925 | ||
| 926 | procedure TORDateBox .WMSize(va r Message: TWMSize); | |
| 927 | var | |
| 928 | ofs: Int eger; | |
| 929 | ||
| 930 | begin | |
| 931 | inherite d; | |
| 932 | if Assig ned(FButto n) then | |
| 933 | begin | |
| 934 | if Bor derStyle = bsNone th en | |
| 935 | ofs := 0 | |
| 936 | else | |
| 937 | ofs := 4; | |
| 938 | FButto n.SetBound s(Width - FButton.Wi dth - ofs, 0, FButto n.Width, | |
| 939 | Heig ht - ofs); | |
| 940 | end; | |
| 941 | SetEditR ect; | |
| 942 | end; | |
| 943 | ||
| 944 | procedure TORDateBox .SetTempla teField(co nst Value: Boolean); | |
| 945 | var | |
| 946 | Y: Integ er; | |
| 947 | ||
| 948 | begin | |
| 949 | if (FTem plateField <> Value) then | |
| 950 | begin | |
| 951 | FTempl ateField : = Value; | |
| 952 | Y := T extHeightB yFont(Font .Handle, F ontHeightT ext); | |
| 953 | if Val ue then | |
| 954 | begin | |
| 955 | FBut ton.Width := Y + 2; | |
| 956 | Heig ht := Y; | |
| 957 | Bord erStyle := bsNone; | |
| 958 | end | |
| 959 | else | |
| 960 | begin | |
| 961 | FBut ton.Width := 18; | |
| 962 | Heig ht := Y + AdjVertSiz e; | |
| 963 | Bord erStyle := bsSingle; | |
| 964 | end; | |
| 965 | end; | |
| 966 | end; | |
| 967 | ||
| 968 | function T ORDateBox. SupportsDy namicPrope rty(Proper tyID: Inte ger): Bool ean; | |
| 969 | begin | |
| 970 | Result : = (Propert yID = Dyna PropAccesi bilityCapt ion); | |
| 971 | end; | |
| 972 | ||
| 973 | procedure TORDateBox .ButtonCli ck(Sender: TObject); | |
| 974 | var | |
| 975 | DateDial og: TORDat eTimeDlg; | |
| 976 | ParsedDa te: TFMDat eTime; | |
| 977 | begin | |
| 978 | DateDial og := TORD ateTimeDlg .Create(Ap plication) ; | |
| 979 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- ------ Beg in | |
| 980 | DateDial og.DateRan ge := Date Range; | |
| 981 | if DateS elected <> 0 then // RTC item # 322517 ( 20160518) | |
| 982 | DateDial og.DateTim e := DateS elected; | |
| 983 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- -------- E nd | |
| 984 | if Lengt h(Text) > 0 then | |
| 985 | begin | |
| 986 | Parsed Date := Se rverParseF MDate(Text ); | |
| 987 | if Par sedDate > -1 then | |
| 988 | FFMD ateTime := ParsedDat e | |
| 989 | else | |
| 990 | FFMD ateTime := 0; | |
| 991 | end; | |
| 992 | DateDial og.DateOnl y := FDate Only; | |
| 993 | DateDial og.FMDateT ime := FFM DateTime; | |
| 994 | DateDial og.Require Time := FR equireTime ; | |
| 995 | ||
| 996 | if DateD ialog.Exec ute then | |
| 997 | begin | |
| 998 | FFMDat eTime := D ateDialog. FMDateTime ; | |
| 999 | Update Text; | |
| 1000 | FTimeI sNow := Da teDialog.R elativeTim e = 'NOW'; | |
| 1001 | fDateS elected := DateDialo g.DateTime ; // NSR20 071216 AA 2016-01-22 | |
| 1002 | end; | |
| 1003 | DateDial og.Free; | |
| 1004 | if Assig ned(OnDate DialogClos ed) then | |
| 1005 | OnDate DialogClos ed(self); | |
| 1006 | if Visib le and Ena bled and n ot (csDest roying in self.Compo nentState) then // S ome events may hide the compon ent | |
| 1007 | SetFoc us; | |
| 1008 | end; | |
| 1009 | ||
| 1010 | procedure TORDateBox .Change; | |
| 1011 | begin | |
| 1012 | inherite d Change; | |
| 1013 | FTimeIsN ow := Fals e; | |
| 1014 | end; | |
| 1015 | ||
| 1016 | procedure TORDateBox .KeyDown(v ar Key: Wo rd; Shift: TShiftSta te); | |
| 1017 | begin | |
| 1018 | inherite d KeyDown( Key, Shift ); | |
| 1019 | if (Key = VK_RETUR N) then | |
| 1020 | begin | |
| 1021 | FButto n.Click; | |
| 1022 | Key := 0; | |
| 1023 | end; | |
| 1024 | end; | |
| 1025 | ||
| 1026 | procedure TORDateBox .KeyPress( var Key: C har); | |
| 1027 | begin | |
| 1028 | if Key = #13 then | |
| 1029 | Key := #0; | |
| 1030 | inherite d; | |
| 1031 | end; | |
| 1032 | ||
| 1033 | function T ORDateBox. GetFMDateT ime: TFMDa teTime; | |
| 1034 | begin | |
| 1035 | Result : = 0; | |
| 1036 | if Lengt h(Text) > 0 then | |
| 1037 | Result := Server ParseFMDat e(Text); | |
| 1038 | FFMDateT ime := Res ult; | |
| 1039 | end; | |
| 1040 | ||
| 1041 | function T ORDateBox. GetRelativ eTime: str ing; | |
| 1042 | begin | |
| 1043 | Result : = ''; | |
| 1044 | if FTime IsNow then | |
| 1045 | Result := 'NOW' | |
| 1046 | else if UpperCase( Text) = 'N OW' then | |
| 1047 | Result := 'NOW' | |
| 1048 | else if Length(Tex t) > 0 the n | |
| 1049 | begin | |
| 1050 | FFMDat eTime := S erverParse FMDate(Tex t); | |
| 1051 | if FFM DateTime > 0 then | |
| 1052 | Resu lt := Rela tiveDateTi me(FMDateT imeToDateT ime(FFMDat eTime)); | |
| 1053 | end; | |
| 1054 | end; | |
| 1055 | ||
| 1056 | procedure TORDateBox .SetDateOn ly(Value: Boolean); | |
| 1057 | begin | |
| 1058 | FDateOnl y := Value ; | |
| 1059 | if FDate Only then | |
| 1060 | begin | |
| 1061 | FRequi reTime := False; | |
| 1062 | FFMDat eTime := I nt(FFMDate Time); | |
| 1063 | if FFo rmat = FMT _DATETIME then | |
| 1064 | FFor mat := FMT _DATEONLY; | |
| 1065 | end; | |
| 1066 | UpdateTe xt; | |
| 1067 | end; | |
| 1068 | ||
| 1069 | procedure TORDateBox .SetFMDate Time(Value : TFMDateT ime); | |
| 1070 | begin | |
| 1071 | FFMDateT ime := Val ue; | |
| 1072 | UpdateTe xt; | |
| 1073 | end; | |
| 1074 | ||
| 1075 | procedure TORDateBox .SetRequir eTime(Valu e: Boolean ); | |
| 1076 | begin | |
| 1077 | FRequire Time := Va lue; | |
| 1078 | if FRequ ireTime th en | |
| 1079 | begin | |
| 1080 | if FFo rmat = FMT _DATEONLY then | |
| 1081 | FFor mat := FMT _DATETIME; | |
| 1082 | SetDat eOnly(Fals e); | |
| 1083 | end; | |
| 1084 | end; | |
| 1085 | ||
| 1086 | procedure TORDateBox .SetEditRe ct; | |
| 1087 | { change t he edit re ctangle to not hide the calend ar button - taken fr om SPIN.PA S sample } | |
| 1088 | var | |
| 1089 | Loc: TRe ct; | |
| 1090 | begin | |
| 1091 | SendMess age(Handle , EM_GETRE CT, 0, Lon gint(@Loc) ); | |
| 1092 | Loc.Bott om := Clie ntHeight + 1; // +1 is workaro und for wi ndows pain t bug | |
| 1093 | Loc.Righ t := FButt on.Left - 2; | |
| 1094 | Loc.Top := 0; | |
| 1095 | Loc.Left := 0; | |
| 1096 | SendMess age(Handle , EM_SETRE CTNP, 0, L ongint(@Lo c)); | |
| 1097 | end; | |
| 1098 | ||
| 1099 | procedure TORDateBox .UpdateTex t; | |
| 1100 | begin | |
| 1101 | if FFMDa teTime > 0 then | |
| 1102 | begin | |
| 1103 | if (FF ormat = FM T_DATETIME ) and (Fra c(FFMDateT ime) = 0) then | |
| 1104 | Text := Format FMDateTime (FMT_DATEO NLY, FFMDa teTime) | |
| 1105 | else | |
| 1106 | Text := Format FMDateTime (FFormat, FFMDateTim e); | |
| 1107 | end; | |
| 1108 | end; | |
| 1109 | ||
| 1110 | procedure TORDateBox .Validate( var ErrMsg : string); | |
| 1111 | var | |
| 1112 | dt: TDat eTime; | |
| 1113 | const | |
| 1114 | fmtDT = 'mm/dd/yyy y hh:nn:ss '; | |
| 1115 | begin | |
| 1116 | ErrMsg : = ''; | |
| 1117 | if Lengt h(Text) > 0 then | |
| 1118 | begin | |
| 1119 | { | |
| 1120 | !!!!!! THI S HAS BEEN REMOVED A S IT CAUSE D PROBLEMS WITH REMI NDER DIALO GS - DN S BELLC !!!! !! | |
| 1121 | //We need to m ake sure t hat there is a date entered be fore parse | |
| 1122 | if F RequireTim e and ((Po s('@', Tex t) = 0) or (Length(P iece(Text, '@', 1)) = 0)) then | |
| 1123 | ErrM sg := 'Dat e Required '; | |
| 1124 | } | |
| 1125 | FFMDat eTime := S erverParse FMDate(Tex t); | |
| 1126 | if FFM DateTime < = 0 then | |
| 1127 | ErrM sg := 'Inv alid Date/ Time'; | |
| 1128 | if FRe quireTime and (Frac( FFMDateTim e) = 0) th en | |
| 1129 | ErrM sg := ErrM sg + 'Time Required' + CRLF; | |
| 1130 | if FDa teOnly and (Frac(FFM DateTime) > 0) then | |
| 1131 | ErrM sg := ErrM sg + 'Time not Requi red' + CRL F; | |
| 1132 | ||
| 1133 | dt := FMDateTime ToDateTime (FFMDateTi me); | |
| 1134 | ||
| 1135 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
| 1136 | if (fD ateRange.M inDate > 0 ) and (dt < fDateRan ge.MinDate ) then | |
| 1137 | ErrM sg := ErrM sg + 'Date /Time sele cted (' + FormatDate Time(fmtDT , dt) + | |
| 1138 | ' )' + CRLF + 'can''t be less th an ' + For matDateTim e(fmtDT, | |
| 1139 | fD ateRange.M inDate) + CRLF; | |
| 1140 | if (fD ateRange.M axDate > 0 ) and (dt > fDateRan ge.MaxDate ) then | |
| 1141 | ErrM sg := ErrM sg + 'Date /Time sele cted (' + FormatDate Time(fmtDT , dt) + | |
| 1142 | ') ' + CRLF + 'can''t b e greater than ' + F ormatDateT ime(fmtDT, | |
| 1143 | fD ateRange.M axDate) + CRLF; | |
| 1144 | {$IFDEF DE BUG_AA} | |
| 1145 | if Err Msg <> '' then | |
| 1146 | ErrM sg := Name + ': ' + ErrMsg; | |
| 1147 | {$ENDIF} | |
| 1148 | ErrMsg := Trim(E rrMsg); | |
| 1149 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
| 1150 | end; | |
| 1151 | end; | |
| 1152 | ||
| 1153 | function T ORDateBox. IsValid: B oolean; | |
| 1154 | var | |
| 1155 | X: strin g; | |
| 1156 | begin | |
| 1157 | Validate (X); | |
| 1158 | Result : = (Length( X) = 0); | |
| 1159 | if (Leng th(Text) = 0) then | |
| 1160 | Result := False; | |
| 1161 | end; | |
| 1162 | ||
| 1163 | procedure TORDateBox .SetBlackC olorMode(V alue: Bool ean); | |
| 1164 | begin | |
| 1165 | if FBlac kColorMode <> Value then | |
| 1166 | begin | |
| 1167 | FBlack ColorMode := Value; | |
| 1168 | LoadEl lipsis(FBu tton.Glyph , FBlackCo lorMode); | |
| 1169 | end; | |
| 1170 | end; | |
| 1171 | ||
| 1172 | procedure TORDateBox .SetCaptio n(const Va lue: strin g); | |
| 1173 | begin | |
| 1174 | if not A ssigned(FC aption) th en | |
| 1175 | begin | |
| 1176 | FCapti on := TSta ticText.Cr eate(self) ; | |
| 1177 | FCapti on.AutoSiz e := False ; | |
| 1178 | FCapti on.Height := 0; | |
| 1179 | FCapti on.Width : = 0; | |
| 1180 | FCapti on.Visible := True; | |
| 1181 | FCapti on.Parent := Parent; | |
| 1182 | FCapti on.Bringto Front; | |
| 1183 | end; | |
| 1184 | FCaption .Caption : = Value; | |
| 1185 | end; | |
| 1186 | ||
| 1187 | procedure TORDateBox .SetEnable d(Value: B oolean); | |
| 1188 | begin | |
| 1189 | FButton. Enabled := Value; | |
| 1190 | inherite d; | |
| 1191 | end; | |
| 1192 | ||
| 1193 | function T ORDateBox. GetCaption : string; | |
| 1194 | begin | |
| 1195 | Result : = FCaption .Caption; | |
| 1196 | end; | |
| 1197 | ||
| 1198 | function T ORDateBox. GetDynamic Property(P ropertyID: Integer): string; | |
| 1199 | begin | |
| 1200 | if Prope rtyID = Dy naPropAcce sibilityCa ption then | |
| 1201 | Result := GetCap tion | |
| 1202 | else | |
| 1203 | Result := ''; | |
| 1204 | end; | |
| 1205 | ||
| 1206 | function I sLeapYear( AYear: Int eger): Boo lean; | |
| 1207 | begin | |
| 1208 | Result : = (AYear m od 4 = 0) and ((AYea r mod 100 <> 0) or ( AYear mod 400 = 0)); | |
| 1209 | end; | |
| 1210 | ||
| 1211 | function D aysPerMont h(AYear, A Month: Int eger): Int eger; | |
| 1212 | const | |
| 1213 | DaysInMo nth: array [1 .. 12] of Intege r = (31, 2 8, 31, 30, 31, 30, 3 1, 31, 30, | |
| 1214 | 31, 30 , 31); | |
| 1215 | begin | |
| 1216 | if (AYea r < 1) or (AMonth < 1) then | |
| 1217 | Result := 0 | |
| 1218 | else | |
| 1219 | begin | |
| 1220 | Result := DaysIn Month[AMon th]; | |
| 1221 | if (AM onth = 2) and IsLeap Year(AYear ) then | |
| 1222 | Inc( Result); { leap-year Feb is sp ecial } | |
| 1223 | end; | |
| 1224 | end; | |
| 1225 | ||
| 1226 | { TORDateC ombo ----- ---------- ---------- ---------- ---------- ---------- ---------- -------- } | |
| 1227 | ||
| 1228 | const | |
| 1229 | ComboBox AdjSize = 24; | |
| 1230 | EditAdjH orzSize = 8; | |
| 1231 | DateComb oCtrlGap = 2; | |
| 1232 | FirstYea r = 1800; | |
| 1233 | LastYear = 2200; | |
| 1234 | ||
| 1235 | { TORDat eComboEdit } | |
| 1236 | ||
| 1237 | procedure TORYearEdi t.SetTempl ateField(c onst Value : Boolean) ; | |
| 1238 | begin | |
| 1239 | if (FTem plateField <> Value) then | |
| 1240 | begin | |
| 1241 | FTempl ateField : = Value; | |
| 1242 | if Val ue then | |
| 1243 | Bord erStyle := bsNone | |
| 1244 | else | |
| 1245 | Bord erStyle := bsSingle; | |
| 1246 | end; | |
| 1247 | end; | |
| 1248 | ||
| 1249 | { TORDateC ombo } | |
| 1250 | ||
| 1251 | constructo r TORDateC ombo.Creat e(AOwner: TComponent ); | |
| 1252 | begin | |
| 1253 | inherite d; | |
| 1254 | ControlS tyle := Co ntrolStyle - [csSetC aption, cs AcceptsCon trols]; | |
| 1255 | BevelOut er := bvNo ne; | |
| 1256 | FInclude Month := T rue; | |
| 1257 | FInclude Day := Tru e; | |
| 1258 | FInclude Btn := Tru e; | |
| 1259 | OnResize := Resize d; | |
| 1260 | FORYearE ditClass : = TORYearE dit; | |
| 1261 | end; | |
| 1262 | ||
| 1263 | destructor TORDateCo mbo.Destro y; | |
| 1264 | begin | |
| 1265 | if Assig ned(FMonth Combo) the n | |
| 1266 | FMonth Combo.Free ; | |
| 1267 | if Assig ned(FDayCo mbo) then | |
| 1268 | FDayCo mbo.Free; | |
| 1269 | if Assig ned(FYearE dit) then | |
| 1270 | FYearE dit.Free; | |
| 1271 | if Assig ned(FYearU D) then | |
| 1272 | FYearU D.Free; | |
| 1273 | if Assig ned(FCalBt n) then | |
| 1274 | FCalBt n.Free; | |
| 1275 | inherite d; | |
| 1276 | end; | |
| 1277 | ||
| 1278 | function T ORDateComb o.GetYearS ize: Integ er; | |
| 1279 | begin | |
| 1280 | Result : = TextWidt hByFont(Fo nt.Handle, '8888') + EditAdjHo rzSize; | |
| 1281 | end; | |
| 1282 | ||
| 1283 | function T ORDateComb o.InitDays (GetSize: Boolean): Integer; | |
| 1284 | var | |
| 1285 | dy: Inte ger; | |
| 1286 | begin | |
| 1287 | Result : = 0; | |
| 1288 | if (Assi gned(FDayC ombo)) the n | |
| 1289 | begin | |
| 1290 | dy := DaysPerMon th(FYear, FMonth) + 1; | |
| 1291 | while (FDayCombo .Items.Cou nt < dy) d o | |
| 1292 | begin | |
| 1293 | if ( FDayCombo. Items.Coun t = 0) the n | |
| 1294 | FD ayCombo.It ems.Add(' ') | |
| 1295 | else | |
| 1296 | FD ayCombo.It ems.Add(In tToStr(FDa yCombo.Ite ms.Count)) ; | |
| 1297 | end; | |
| 1298 | while (FDayCombo .Items.Cou nt > dy) d o | |
| 1299 | FDay Combo.Item s.Delete(F DayCombo.I tems.Count - 1); | |
| 1300 | if (Ge tSize) the n | |
| 1301 | Resu lt := Text WidthByFon t(Font.Han dle, '88') + ComboBo xAdjSize; | |
| 1302 | if (FD ay > (dy - 1)) then | |
| 1303 | SetD ay(dy - 1) ; | |
| 1304 | end; | |
| 1305 | end; | |
| 1306 | ||
| 1307 | function T ORDateComb o.InitMont hs(GetSize : Boolean) : Integer; | |
| 1308 | var | |
| 1309 | i, Size: Integer; | |
| 1310 | begin | |
| 1311 | Result : = 0; | |
| 1312 | if (Assi gned(FMont hCombo)) t hen | |
| 1313 | begin | |
| 1314 | FMonth Combo.Item s.Clear; | |
| 1315 | FMonth Combo.Item s.Add(' ') ; | |
| 1316 | for i := 1 to 12 do | |
| 1317 | begin | |
| 1318 | if F LongMonths then | |
| 1319 | FM onthCombo. Items.Add( FormatSett ings.LongM onthNames[ i]) | |
| 1320 | else | |
| 1321 | FM onthCombo. Items.Add( FormatSett ings.Short MonthNames [i]); | |
| 1322 | if G etSize the n | |
| 1323 | begi n | |
| 1324 | Si ze := Text WidthByFon t(Font.Han dle, FMont hCombo.Ite ms[i]); | |
| 1325 | if (Result < Size) the n | |
| 1326 | Result := Size; | |
| 1327 | end; | |
| 1328 | end; | |
| 1329 | if Get Size then | |
| 1330 | Inc( Result, Co mboBoxAdjS ize); | |
| 1331 | end; | |
| 1332 | end; | |
| 1333 | ||
| 1334 | procedure TORDateCom bo.Rebuild ; | |
| 1335 | var | |
| 1336 | Wide, X, Y: Intege r; | |
| 1337 | ||
| 1338 | begin | |
| 1339 | if (not FRebuildin g) then | |
| 1340 | begin | |
| 1341 | FRebui lding := T rue; | |
| 1342 | try | |
| 1343 | Cont rolStyle : = ControlS tyle + [cs AcceptsCon trols]; | |
| 1344 | try | |
| 1345 | Y := TextHei ghtByFont( Font.Handl e, FontHei ghtText); | |
| 1346 | if not FTemp lateField then | |
| 1347 | Inc(Y, Adj VertSize); | |
| 1348 | X := 0; | |
| 1349 | if (FInclude Month) the n | |
| 1350 | be gin | |
| 1351 | if (not As signed(FMo nthCombo)) then | |
| 1352 | begin | |
| 1353 | FMonthCo mbo := TOR MonthCombo .Create(se lf); | |
| 1354 | FMonthCo mbo.Parent := self; | |
| 1355 | FMonthCo mbo.Top := 0; | |
| 1356 | FMonthCo mbo.Left : = 0; | |
| 1357 | FMonthCo mbo.Style := orcsDro pDown; | |
| 1358 | FMonthCo mbo.DropDo wnCount := 13; | |
| 1359 | FMonthCo mbo.ListIt emsOnly := True; | |
| 1360 | FMonthCo mbo.OnChan ge := Mont hChanged; | |
| 1361 | end; | |
| 1362 | FMonthComb o.Font := Font; | |
| 1363 | FMonthComb o.Template Field := F TemplateFi eld; | |
| 1364 | Wide := In itMonths(T rue); | |
| 1365 | FMonthComb o.Width := Wide; | |
| 1366 | FMonthComb o.Height : = Y; | |
| 1367 | FMonthComb o.ItemInde x := FMont h; | |
| 1368 | Inc(X, Wid e + DateCo mboCtrlGap ); | |
| 1369 | ||
| 1370 | if (FInclu deDay) the n | |
| 1371 | begin | |
| 1372 | if (not Assigned(F DayCombo)) then | |
| 1373 | begin | |
| 1374 | FDayCo mbo := TOR DayCombo.C reate(self ); | |
| 1375 | FDayCo mbo.Parent := self; | |
| 1376 | FDayCo mbo.Top := 0; | |
| 1377 | FDayCo mbo.Style := orcsDro pDown; | |
| 1378 | FDayCo mbo.ListIt emsOnly := True; | |
| 1379 | FDayCo mbo.OnChan ge := DayC hanged; | |
| 1380 | FDayCo mbo.DropDo wnCount := 11; | |
| 1381 | end; | |
| 1382 | FDayComb o.Font := Font; | |
| 1383 | FDayComb o.Template Field := F TemplateFi eld; | |
| 1384 | Wide := InitDays(T rue); | |
| 1385 | FDayComb o.Width := Wide; | |
| 1386 | FDayComb o.Height : = Y; | |
| 1387 | FDayComb o.Left := X; | |
| 1388 | FDayComb o.ItemInde x := FDay; | |
| 1389 | Inc(X, W ide + Date ComboCtrlG ap); | |
| 1390 | end | |
| 1391 | else if As signed(FDa yCombo) th en | |
| 1392 | begin | |
| 1393 | FDayComb o.Free; | |
| 1394 | FDayComb o := nil; | |
| 1395 | end; | |
| 1396 | en d | |
| 1397 | el se | |
| 1398 | be gin | |
| 1399 | if Assigne d(FDayComb o) then | |
| 1400 | begin | |
| 1401 | FDayComb o.Free; | |
| 1402 | FDayComb o := nil; | |
| 1403 | end; | |
| 1404 | if Assigne d(FMonthCo mbo) then | |
| 1405 | begin | |
| 1406 | FMonthCo mbo.Free; | |
| 1407 | FMonthCo mbo := nil ; | |
| 1408 | end; | |
| 1409 | en d; | |
| 1410 | if (not Assi gned(FYear Edit)) the n | |
| 1411 | be gin | |
| 1412 | FYearEdit := FORYear EditClass. Create(sel f); | |
| 1413 | FYearEdit. Parent := self; | |
| 1414 | FYearEdit. Top := 0; | |
| 1415 | FYearEdit. EditMask : = '9999;1; '; | |
| 1416 | FYearEdit. OnKeyPress := YearKe yPress; | |
| 1417 | FYearEdit. OnChange : = YearChan ged; | |
| 1418 | en d; | |
| 1419 | FY earEdit.Fo nt := Font ; | |
| 1420 | FY earEdit.Te mplateFiel d := FTemp lateField; | |
| 1421 | Wi de := GetY earSize; | |
| 1422 | FY earEdit.Wi dth := Wid e; | |
| 1423 | FY earEdit.He ight := Y; | |
| 1424 | FY earEdit.Le ft := X; | |
| 1425 | In c(X, Wide) ; | |
| 1426 | if (not Assi gned(FYear UD)) then | |
| 1427 | be gin | |
| 1428 | FYearUD := TUpDown.C reate(self ); | |
| 1429 | FYearUD.Pa rent := se lf; | |
| 1430 | FYearUD.Th ousands := False; | |
| 1431 | FYearUD.Mi n := First Year - 1; | |
| 1432 | FYearUD.Ma x := LastY ear; | |
| 1433 | FYearUD.On ChangingEx := YearUD Change; | |
| 1434 | en d; | |
| 1435 | FY earEdit.Ta bOrder := 0; | |
| 1436 | FY earUD.Top := 0; | |
| 1437 | FY earUD.Left := X; | |
| 1438 | FY earUD.Heig ht := Y; | |
| 1439 | FY earUD.Posi tion := FY ear; | |
| 1440 | In c(X, FYear UD.Width + DateCombo CtrlGap); | |
| 1441 | if (FInclude Btn) then | |
| 1442 | be gin | |
| 1443 | if (not As signed(FCa lBtn)) the n | |
| 1444 | begin | |
| 1445 | FCalBtn := TORDate Button.Cre ate(self); | |
| 1446 | FCalBtn. TabStop := False; | |
| 1447 | FCalBtn. Parent := self; | |
| 1448 | FCalBtn. Top := 0; | |
| 1449 | LoadElli psis(FCalB tn.Glyph, FBlackColo rMode); | |
| 1450 | FCalBtn. OnClick := BtnClicke d; | |
| 1451 | end; | |
| 1452 | Wide := FY earEdit.He ight; | |
| 1453 | if (Wide > Y) then | |
| 1454 | Wide := Y; | |
| 1455 | FCalBtn.Wi dth := Wid e; | |
| 1456 | FCalBtn.He ight := Wi de; | |
| 1457 | FCalBtn.Le ft := X; | |
| 1458 | Inc(X, Wid e + DateCo mboCtrlGap ); | |
| 1459 | en d | |
| 1460 | el se if Assi gned(FCalB tn) then | |
| 1461 | be gin | |
| 1462 | FCalBtn.Fr ee; | |
| 1463 | FCalBtn := nil; | |
| 1464 | en d; | |
| 1465 | se lf.Width : = X - Date ComboCtrlG ap; | |
| 1466 | se lf.Height := Y; | |
| 1467 | Ch eckDays; | |
| 1468 | FC trlsCreate d := True; | |
| 1469 | Do Change; | |
| 1470 | fina lly | |
| 1471 | Co ntrolStyle := Contro lStyle - [ csAcceptsC ontrols]; | |
| 1472 | end; | |
| 1473 | finall y | |
| 1474 | FReb uilding := False; | |
| 1475 | end; | |
| 1476 | end; | |
| 1477 | end; | |
| 1478 | ||
| 1479 | procedure TORDateCom bo.SetBlac kColorMode (Value: Bo olean); | |
| 1480 | begin | |
| 1481 | if FBlac kColorMode <> Value then | |
| 1482 | begin | |
| 1483 | FBlack ColorMode := Value; | |
| 1484 | if Ass igned(FCal Btn) then | |
| 1485 | Load Ellipsis(F CalBtn.Gly ph, FBlack ColorMode) ; | |
| 1486 | end; | |
| 1487 | end; | |
| 1488 | ||
| 1489 | procedure TORDateCom bo.SetDay( Value: Int eger); | |
| 1490 | begin | |
| 1491 | if (not Assigned(F DayCombo)) and (not( csLoading in Compone ntState)) then | |
| 1492 | Value := 0; | |
| 1493 | if (Valu e > DaysPe rMonth(FYe ar, FMonth )) then | |
| 1494 | Value := 0; | |
| 1495 | if (FDay <> Value) then | |
| 1496 | begin | |
| 1497 | FDay : = Value; | |
| 1498 | if (As signed(FDa yCombo)) t hen | |
| 1499 | begin | |
| 1500 | if ( FDayCombo. Items.Coun t <= FDay) then | |
| 1501 | In itDays(Fal se); | |
| 1502 | FDay Combo.Item Index := F Day; | |
| 1503 | end; | |
| 1504 | DoChan ge; | |
| 1505 | end; | |
| 1506 | end; | |
| 1507 | ||
| 1508 | procedure TORDateCom bo.SetIncl udeBtn(con st Value: Boolean); | |
| 1509 | begin | |
| 1510 | if (FInc ludeBtn <> Value) th en | |
| 1511 | begin | |
| 1512 | FInclu deBtn := V alue; | |
| 1513 | Rebuil d; | |
| 1514 | end; | |
| 1515 | end; | |
| 1516 | ||
| 1517 | procedure TORDateCom bo.SetIncl udeDay(Val ue: Boolea n); | |
| 1518 | begin | |
| 1519 | if (Valu e) and (no t FInclude Month) the n | |
| 1520 | Value := False; | |
| 1521 | if (FInc ludeDay <> Value) th en | |
| 1522 | begin | |
| 1523 | FInclu deDay := V alue; | |
| 1524 | if (no t Value) t hen | |
| 1525 | FDay := 0; | |
| 1526 | Rebuil d; | |
| 1527 | end; | |
| 1528 | end; | |
| 1529 | ||
| 1530 | procedure TORDateCom bo.SetIncl udeMonth(c onst Value : Boolean) ; | |
| 1531 | begin | |
| 1532 | if (FInc ludeMonth <> Value) then | |
| 1533 | begin | |
| 1534 | FInclu deMonth := Value; | |
| 1535 | if (no t Value) t hen | |
| 1536 | begin | |
| 1537 | FInc ludeDay := False; | |
| 1538 | FMon th := 0; | |
| 1539 | FDay := 0; | |
| 1540 | end; | |
| 1541 | Rebuil d; | |
| 1542 | end; | |
| 1543 | end; | |
| 1544 | ||
| 1545 | procedure TORDateCom bo.SetMont h(Value: I nteger); | |
| 1546 | begin | |
| 1547 | if (not Assigned(F MonthCombo )) and (no t(csLoadin g in Compo nentState) ) then | |
| 1548 | Value := 0; | |
| 1549 | if (Valu e < 0) or (Value > 1 2) then | |
| 1550 | Value := 0; | |
| 1551 | if (FMon th <> Valu e) then | |
| 1552 | begin | |
| 1553 | FMonth := Value; | |
| 1554 | if (As signed(FMo nthCombo)) then | |
| 1555 | FMon thCombo.It emIndex := FMonth; | |
| 1556 | CheckD ays; | |
| 1557 | DoChan ge; | |
| 1558 | end; | |
| 1559 | end; | |
| 1560 | ||
| 1561 | procedure TORDateCom bo.SetLong Months(con st Value: Boolean); | |
| 1562 | begin | |
| 1563 | if (FLon gMonths <> Value) th en | |
| 1564 | begin | |
| 1565 | FLongM onths := V alue; | |
| 1566 | Rebuil d; | |
| 1567 | end; | |
| 1568 | end; | |
| 1569 | ||
| 1570 | procedure TORDateCom bo.SetYear (const Val ue: Intege r); | |
| 1571 | begin | |
| 1572 | if (FYea r <> Value ) then | |
| 1573 | begin | |
| 1574 | FYear := Value; | |
| 1575 | if (FY ear < Firs tYear) or (FYear > L astYear) t hen | |
| 1576 | FYea r := 0; | |
| 1577 | if (no t FYearCha nging) and (Assigned (FYearEdit )) and (As signed(FYe arUD)) | |
| 1578 | then | |
| 1579 | begin | |
| 1580 | FYea rChanging := True; | |
| 1581 | try | |
| 1582 | if (FYear = 0) then | |
| 1583 | be gin | |
| 1584 | FYearEdit. Text := ' '; | |
| 1585 | FYearUD.Po sition := FirstYear - 1 | |
| 1586 | en d | |
| 1587 | el se | |
| 1588 | be gin | |
| 1589 | FYearEdit. Text := In tToStr(FYe ar); | |
| 1590 | FYearUD.Po sition := FYear; | |
| 1591 | en d; | |
| 1592 | fina lly | |
| 1593 | FY earChangin g := False ; | |
| 1594 | end; | |
| 1595 | end; | |
| 1596 | if (FM onth = 2) then | |
| 1597 | Init Days(False ); | |
| 1598 | CheckD ays; | |
| 1599 | DoChan ge; | |
| 1600 | end; | |
| 1601 | end; | |
| 1602 | ||
| 1603 | procedure TORDateCom bo.DayChan ged(Sender : TObject) ; | |
| 1604 | begin | |
| 1605 | FDay := FDayCombo. ItemIndex; | |
| 1606 | if (FDay < 0) then | |
| 1607 | FDay : = 0; | |
| 1608 | CheckDay s; | |
| 1609 | DoChange ; | |
| 1610 | end; | |
| 1611 | ||
| 1612 | procedure TORDateCom bo.MonthCh anged(Send er: TObjec t); | |
| 1613 | begin | |
| 1614 | FMonth : = FMonthCo mbo.ItemIn dex; | |
| 1615 | if (FMon th < 0) th en | |
| 1616 | FMonth := 0; | |
| 1617 | InitDays (False); | |
| 1618 | CheckDay s; | |
| 1619 | DoChange ; | |
| 1620 | end; | |
| 1621 | ||
| 1622 | procedure TORDateCom bo.YearCha nged(Sende r: TObject ); | |
| 1623 | begin | |
| 1624 | if FYear Changing t hen | |
| 1625 | exit; | |
| 1626 | FYearCha nging := T rue; | |
| 1627 | try | |
| 1628 | FYear := StrToIn tDef(FYear Edit.Text, 0); | |
| 1629 | if (FY ear < Firs tYear) or (FYear > L astYear) t hen | |
| 1630 | FYea r := 0; | |
| 1631 | if (FY ear = 0) t hen | |
| 1632 | FYea rUD.Positi on := Firs tYear - 1 | |
| 1633 | else | |
| 1634 | FYea rUD.Positi on := FYea r; | |
| 1635 | if (FM onth = 2) then | |
| 1636 | Init Days(False ); | |
| 1637 | CheckD ays; | |
| 1638 | DoChan ge; | |
| 1639 | finally | |
| 1640 | FYearC hanging := False; | |
| 1641 | end; | |
| 1642 | end; | |
| 1643 | ||
| 1644 | procedure TORDateCom bo.CheckDa ys; | |
| 1645 | var | |
| 1646 | MaxDays: Integer; | |
| 1647 | ||
| 1648 | begin | |
| 1649 | if (FInc ludeMonth and Assign ed(FMonthC ombo)) the n | |
| 1650 | begin | |
| 1651 | FMonth Combo.Enab led := (FY ear > 0); | |
| 1652 | if (FY ear = 0) t hen | |
| 1653 | SetM onth(0); | |
| 1654 | if (FI ncludeMont h and FInc ludeDay an d Assigned (FDayCombo )) then | |
| 1655 | begin | |
| 1656 | FDay Combo.Enab led := ((F Year > 0) and (FMont h > 0)); | |
| 1657 | MaxD ays := Day sPerMonth( FYear, FMo nth); | |
| 1658 | if ( FDay > Max Days) then | |
| 1659 | Se tDay(MaxDa ys); | |
| 1660 | end; | |
| 1661 | end; | |
| 1662 | end; | |
| 1663 | ||
| 1664 | procedure TORDateCom bo.Loaded; | |
| 1665 | begin | |
| 1666 | inherite d; | |
| 1667 | if (not FCtrlsCrea ted) then | |
| 1668 | Rebuil d; | |
| 1669 | end; | |
| 1670 | ||
| 1671 | procedure TORDateCom bo.Paint; | |
| 1672 | begin | |
| 1673 | if (not FCtrlsCrea ted) then | |
| 1674 | Rebuil d; | |
| 1675 | inherite d; | |
| 1676 | end; | |
| 1677 | ||
| 1678 | procedure TORDateCom bo.BtnClic ked(Sender : TObject) ; | |
| 1679 | var | |
| 1680 | mm, dd, yy: Intege r; | |
| 1681 | m, d, Y: Word; | |
| 1682 | DateDial og: TORDat eTimeDlg; | |
| 1683 | begin | |
| 1684 | DateDial og := TORD ateTimeDlg .Create(se lf); | |
| 1685 | try | |
| 1686 | mm := FMonth; | |
| 1687 | dd := FDay; | |
| 1688 | yy := FYear; | |
| 1689 | Decode Date(Now, Y, m, d); | |
| 1690 | if (FY ear = 0) t hen | |
| 1691 | FYea r := Y; | |
| 1692 | if (FY ear = Y) t hen | |
| 1693 | begin | |
| 1694 | if ( (FMonth = 0) or (FMo nth = m)) and (FDay = 0) then | |
| 1695 | begi n | |
| 1696 | FM onth := m; | |
| 1697 | FD ay := d; | |
| 1698 | end; | |
| 1699 | end; | |
| 1700 | if (FM onth = 0) then | |
| 1701 | FMon th := 1; | |
| 1702 | if (FD ay = 0) th en | |
| 1703 | FDay := 1; | |
| 1704 | DateDi alog.FMDat eTime := G etFMDate; | |
| 1705 | DateDi alog.DateO nly := Tru e; | |
| 1706 | DateDi alog.Requi reTime := False; | |
| 1707 | if Dat eDialog.Ex ecute then | |
| 1708 | begin | |
| 1709 | FYea r := 0; | |
| 1710 | FMon th := 0; | |
| 1711 | FDay := 0; | |
| 1712 | SetF MDate(Date Dialog.FMD ateTime); | |
| 1713 | end | |
| 1714 | else | |
| 1715 | begin | |
| 1716 | SetY ear(yy); | |
| 1717 | SetM onth(mm); | |
| 1718 | SetD ay(dd); | |
| 1719 | end; | |
| 1720 | finally | |
| 1721 | DateDi alog.Free; | |
| 1722 | end; | |
| 1723 | end; | |
| 1724 | ||
| 1725 | procedure TORDateCom bo.YearUDC hange(Send er: TObjec t; var All owChange: Boolean; | |
| 1726 | NewValue : Integer; Direction : TUpDownD irection); | |
| 1727 | var | |
| 1728 | Y, m, d: Word; | |
| 1729 | begin | |
| 1730 | if FYear Changing t hen | |
| 1731 | exit; | |
| 1732 | FYearCha nging := T rue; | |
| 1733 | try | |
| 1734 | if FYe arUD.Posit ion = (Fir stYear - 1 ) then | |
| 1735 | begin | |
| 1736 | Deco deDate(Now , Y, m, d) ; | |
| 1737 | FYea r := Y; | |
| 1738 | FYea rUD.Positi on := Y; | |
| 1739 | Allo wChange := False; | |
| 1740 | end | |
| 1741 | else | |
| 1742 | FYea r := NewVa lue; | |
| 1743 | if (FY ear < Firs tYear) or (FYear > L astYear) t hen | |
| 1744 | FYea r := 0; | |
| 1745 | if (FY ear = 0) t hen | |
| 1746 | FYea rEdit.Text := ' ' | |
| 1747 | else | |
| 1748 | FYea rEdit.Text := IntToS tr(FYear); | |
| 1749 | if (FM onth = 2) then | |
| 1750 | Init Days(False ); | |
| 1751 | CheckD ays; | |
| 1752 | DoChan ge; | |
| 1753 | finally | |
| 1754 | FYearC hanging := False; | |
| 1755 | end; | |
| 1756 | end; | |
| 1757 | ||
| 1758 | procedure TORDateCom bo.YearKey Press(Send er: TObjec t; var Key : Char); | |
| 1759 | begin | |
| 1760 | if CharI nSet(Key, ['0' .. '9 ']) and (F YearEdit.T ext = ' ') then | |
| 1761 | begin | |
| 1762 | FYearE dit.Text : = Key + ' '; | |
| 1763 | Key := #0; | |
| 1764 | FYearE dit.SelSta rt := 1; | |
| 1765 | FYearE dit.SelTex t := ''; | |
| 1766 | end; | |
| 1767 | end; | |
| 1768 | ||
| 1769 | function T ORDateComb o.GetFMDat e: TFMDate Time; | |
| 1770 | begin | |
| 1771 | if (FYea r < FirstY ear) then | |
| 1772 | Result := 0 | |
| 1773 | else | |
| 1774 | Result := ((FYea r - 1700) * 10000 + FMonth * 1 00 + FDay) ; | |
| 1775 | end; | |
| 1776 | ||
| 1777 | procedure TORDateCom bo.SetFMDa te(const V alue: TFMD ateTime); | |
| 1778 | var | |
| 1779 | ival, mo , dy: Inte ger; | |
| 1780 | begin | |
| 1781 | if (Valu e = 0) the n | |
| 1782 | begin | |
| 1783 | SetYea r(0); | |
| 1784 | SetMon th(0); | |
| 1785 | end | |
| 1786 | else | |
| 1787 | begin | |
| 1788 | ival : = Trunc(Va lue); | |
| 1789 | if (Le ngth(IntTo Str(ival)) <> 7) the n | |
| 1790 | exit ; | |
| 1791 | dy := (ival mod 100); | |
| 1792 | ival : = ival div 100; | |
| 1793 | mo := ival mod 1 00; | |
| 1794 | ival : = ival div 100; | |
| 1795 | SetYea r(ival + 1 700); | |
| 1796 | SetMon th(mo); | |
| 1797 | InitDa ys(False); | |
| 1798 | SetDay (dy); | |
| 1799 | end; | |
| 1800 | end; | |
| 1801 | ||
| 1802 | function T ORDateComb o.DateText : string; | |
| 1803 | begin | |
| 1804 | Result : = ''; | |
| 1805 | if (FYea r > 0) the n | |
| 1806 | begin | |
| 1807 | if (FM onth > 0) then | |
| 1808 | begin | |
| 1809 | if F LongMonths then | |
| 1810 | Re sult := Fo rmatSettin gs.LongMon thNames[FM onth] | |
| 1811 | else | |
| 1812 | Re sult := Fo rmatSettin gs.ShortMo nthNames[F Month]; | |
| 1813 | if ( FDay > 0) then | |
| 1814 | Re sult := Re sult + ' ' + IntToSt r(FDay); | |
| 1815 | Resu lt := Resu lt + ', '; | |
| 1816 | end; | |
| 1817 | Result := Result + IntToSt r(FYear); | |
| 1818 | end; | |
| 1819 | end; | |
| 1820 | ||
| 1821 | procedure TORDateCom bo.DoChang e; | |
| 1822 | begin | |
| 1823 | if Assig ned(FOnCha nge) then | |
| 1824 | FOnCha nge(self); | |
| 1825 | end; | |
| 1826 | ||
| 1827 | procedure TORDateCom bo.Resized (Sender: T Object); | |
| 1828 | begin | |
| 1829 | Rebuild; | |
| 1830 | end; | |
| 1831 | ||
| 1832 | procedure TORDateCom bo.CMFontC hanged(var Message: TMessage); | |
| 1833 | begin | |
| 1834 | inherite d; | |
| 1835 | Rebuild; | |
| 1836 | end; | |
| 1837 | ||
| 1838 | function T ORDateComb o.Text: st ring; | |
| 1839 | var | |
| 1840 | tmp, fmt , m: strin g; | |
| 1841 | begin | |
| 1842 | Result : = ''; | |
| 1843 | tmp := F loatToStr( FMDate); | |
| 1844 | if (tmp <> '') and (tmp <> ' 0') and (L ength(tmp) >= 7) the n | |
| 1845 | begin | |
| 1846 | if FLo ngMonths t hen | |
| 1847 | m := 'mmmm' | |
| 1848 | else | |
| 1849 | m := 'mmm'; | |
| 1850 | if (co py(tmp, 4, 4) = '000 0') then | |
| 1851 | fmt := 'yyyy' | |
| 1852 | else i f (copy(tm p, 6, 2) = '00') the n | |
| 1853 | fmt := m + ', YYYY' | |
| 1854 | else | |
| 1855 | fmt := m + ' D , YYYY'; | |
| 1856 | Result := Format FMDateTime Str(fmt, t mp) | |
| 1857 | end; | |
| 1858 | end; | |
| 1859 | ||
| 1860 | procedure Register; | |
| 1861 | { used by Delphi to put compon ents on th e Palette } | |
| 1862 | begin | |
| 1863 | Register Components ('CPRS', [ TORDateTim eDlg, TORD ateBox, TO RDateCombo ]); | |
| 1864 | end; | |
| 1865 | ||
| 1866 | procedure TORDateCom bo.SetTemp lateField( const Valu e: Boolean ); | |
| 1867 | begin | |
| 1868 | if FTemp lateField <> Value t hen | |
| 1869 | begin | |
| 1870 | FTempl ateField : = Value; | |
| 1871 | Rebuil d; | |
| 1872 | end; | |
| 1873 | end; | |
| 1874 | ||
| 1875 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ---- Begin | |
| 1876 | ||
| 1877 | Procedure TORDateCom bo.SetColo r(const Va lue: TColo r); | |
| 1878 | begin | |
| 1879 | fColor : = Value; | |
| 1880 | if Assig ned(FMonth Combo) the n | |
| 1881 | FMonth Combo.Colo r := fColo r; | |
| 1882 | if Assig ned(FDayCo mbo) then | |
| 1883 | FDayCo mbo.Color := fColor; | |
| 1884 | if Assig ned(FYearE dit) then | |
| 1885 | FYearE dit.Color := fColor; | |
| 1886 | end; | |
| 1887 | ||
| 1888 | { TORCalen dar ------ ---------- ---------- ---------- ---------- ---------- ---------- ---------- --- } | |
| 1889 | constructo r TORCalen dar.Create (AOwner: T Component) ; | |
| 1890 | begin | |
| 1891 | inherite d Create(A Owner); | |
| 1892 | end; | |
| 1893 | ||
| 1894 | destructor TORCalend ar.Destroy (); | |
| 1895 | begin | |
| 1896 | inherite d; | |
| 1897 | end; | |
| 1898 | ||
| 1899 | procedure TORCalenda r.KeyDown( var Key: W ord; Shift : TShiftSt ate); | |
| 1900 | var | |
| 1901 | iDelta: Integer; | |
| 1902 | begin | |
| 1903 | // inher ited; | |
| 1904 | if ssCtr l in Shift then | |
| 1905 | iDelta := 11 | |
| 1906 | else | |
| 1907 | iDelta := 0; | |
| 1908 | ||
| 1909 | if Key = VK_PRIOR then | |
| 1910 | begin | |
| 1911 | Calend arDate := IncMonth(C alendarDat e, -iDelta ); | |
| 1912 | if isR angeMode a nd (Calend arDate < M inDateTime ) then | |
| 1913 | Cale ndarDate : = MinDateT ime; | |
| 1914 | end | |
| 1915 | else if Key = VK_L EFT then | |
| 1916 | begin | |
| 1917 | Calend arDate := CalendarDa te - 1; | |
| 1918 | if isR angeMode a nd (Calend arDate < M inDateTime ) then | |
| 1919 | Cale ndarDate : = MinDateT ime; | |
| 1920 | end | |
| 1921 | else if Key = VK_N EXT then | |
| 1922 | begin | |
| 1923 | Calend arDate := IncMonth(C alendarDat e, iDelta) ; | |
| 1924 | if isR angeMode a nd (Calend arDate > M axDateTime ) then | |
| 1925 | Cale ndarDate : = MaxDateT ime; | |
| 1926 | end | |
| 1927 | else if Key = VK_R IGHT then | |
| 1928 | begin | |
| 1929 | Calend arDate := CalendarDa te + 1; | |
| 1930 | if isR angeMode a nd (Calend arDate > M axDateTime ) then | |
| 1931 | Cale ndarDate : = MaxDateT ime; | |
| 1932 | end; | |
| 1933 | end; | |
| 1934 | ||
| 1935 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ---- Begin | |
| 1936 | ||
| 1937 | procedure TORCalenda r.SetValid Range(aRan ge: TDateR ange); | |
| 1938 | begin | |
| 1939 | fValidRa nge := aRa nge; | |
| 1940 | if Valid Range.IsBe tweenMinAn dMax(Serve rToday) th en | |
| 1941 | Calend arDate := ServerToda y | |
| 1942 | else | |
| 1943 | Calend arDate := ValidRange .MinDate; | |
| 1944 | end; | |
| 1945 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ------ End | |
| 1946 | ||
| 1947 | function T ORCalendar .getMinDat eTime: TDa teTime; | |
| 1948 | begin | |
| 1949 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- ------ Beg in | |
| 1950 | if Assig ned(ValidR ange) then | |
| 1951 | Result := ValidR ange.MinDa te | |
| 1952 | else | |
| 1953 | Result := -1.0; | |
| 1954 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- -------- E nd | |
| 1955 | end; | |
| 1956 | ||
| 1957 | function T ORCalendar .getMaxDat eTime: TDa teTime; | |
| 1958 | begin | |
| 1959 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- ------ Beg in | |
| 1960 | if Assig ned(ValidR ange) then | |
| 1961 | Result := ValidR ange.MaxDa te | |
| 1962 | else | |
| 1963 | Result := -1.0; | |
| 1964 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- -------- E nd | |
| 1965 | end; | |
| 1966 | ||
| 1967 | function T ORCalendar .IsBetween MinAndMax( const Look upDate: TD ateTime): Boolean; | |
| 1968 | begin | |
| 1969 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- ------ Beg in | |
| 1970 | if Assig ned(ValidR ange) then | |
| 1971 | Result := ValidR ange.IsBet weenMinAnd Max(Lookup Date) | |
| 1972 | else | |
| 1973 | Result := True; | |
| 1974 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- -------- E nd | |
| 1975 | end; | |
| 1976 | ||
| 1977 | function T ORCalendar .isRangeMo de: boolea n; | |
| 1978 | begin | |
| 1979 | // fix for Defect #3 32950: | |
| 1980 | // Access violation in TORDate Combo comp onent on s electing t he date in the assoc iated Cale ndar form | |
| 1981 | Result : = Assigned (ValidRang e) and ( | |
| 1982 | (Valid Range.MaxD ate <> -1) or (Valid Range.MinD ate <> -1) | |
| 1983 | ); | |
| 1984 | end; | |
| 1985 | ||
| 1986 | function T ORCalendar .SelectCel l(ACol, AR ow: Longin t): Boolea n; | |
| 1987 | var | |
| 1988 | TheText: string; | |
| 1989 | DteToChk : TDateTim e; | |
| 1990 | _min, _m ax: TDateT ime; | |
| 1991 | begin | |
| 1992 | Result : = (Inherit ed); | |
| 1993 | ||
| 1994 | TheText := CellTex t[ACol, AR ow]; | |
| 1995 | if TheTe xt = '' th en | |
| 1996 | exit; | |
| 1997 | DteToChk := Encode Date(Year, Month, St rToIntDef( TheText, 0 )); | |
| 1998 | ||
| 1999 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- ------ Beg in | |
| 2000 | if Assig ned(ValidR ange) then | |
| 2001 | begin | |
| 2002 | if Res ult then | |
| 2003 | begin | |
| 2004 | _min := getMin DateTime; | |
| 2005 | _max := getMax DateTime; | |
| 2006 | if _ min <> -1 then | |
| 2007 | Re sult := Da teOf(DteTo Chk) >= Da teOf(Float ToDateTime (_min)); | |
| 2008 | if _ max <> -1 then | |
| 2009 | Re sult := Re sult and | |
| 2010 | (DateOf(Dt eToChk) <= DateOf(Fl oatToDateT ime(_max)) ); | |
| 2011 | end; | |
| 2012 | end; | |
| 2013 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- -------- E nd | |
| 2014 | end; | |
| 2015 | ||
| 2016 | function I nverseColo r(Color: T Color): TC olor; | |
| 2017 | var | |
| 2018 | rgb_: TC olorref; | |
| 2019 | ||
| 2020 | function Inv(b: By te): Byte; | |
| 2021 | begin | |
| 2022 | if b > 128 then | |
| 2023 | Resu lt := 0 | |
| 2024 | else | |
| 2025 | Resu lt := 255; | |
| 2026 | end; | |
| 2027 | ||
| 2028 | begin | |
| 2029 | rgb_ := ColorToRgb (Color); | |
| 2030 | rgb_ := RGB(Inv(Ge tRValue(rg b_)), Inv( GetGValue( rgb_)), In v(GetBValu e(rgb_))); | |
| 2031 | ||
| 2032 | Result : = rgb_; | |
| 2033 | end; | |
| 2034 | ||
| 2035 | procedure TORCalenda r.DrawCell (ACol, ARo w: Longint ; ARect: T Rect; | |
| 2036 | AState: TGridDrawS tate); | |
| 2037 | var | |
| 2038 | TheText: string; | |
| 2039 | DteToChk : TDateTim e; | |
| 2040 | CurMonth , CurYear, CurDay: W ord; | |
| 2041 | UseColor : TColor; | |
| 2042 | _min, _m ax: TDateT ime; | |
| 2043 | ||
| 2044 | begin | |
| 2045 | TheText := CellTex t[ACol, AR ow]; | |
| 2046 | with ARe ct, Canvas do | |
| 2047 | begin | |
| 2048 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
| 2049 | if Ass igned(Vali dRange) th en | |
| 2050 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
| 2051 | begin | |
| 2052 | _min := getMin DateTime; | |
| 2053 | _max := getMax DateTime; | |
| 2054 | ||
| 2055 | if S trToIntDef (TheText, -1) <> -1 then | |
| 2056 | begi n | |
| 2057 | Dt eToChk := EncodeDate (Year, Mon th, StrToI ntDef(TheT ext, 0)); | |
| 2058 | Us eColor := clWindow; | |
| 2059 | // if IsFull Day(DteToC hk) then | |
| 2060 | // UseColor := clLtGra y; | |
| 2061 | ||
| 2062 | if (_min <> -1) and (_ max <> -1) then | |
| 2063 | be gin | |
| 2064 | // All dat es between | |
| 2065 | if not IsB etweenMinA ndMax(DteT oChk) then | |
| 2066 | UseColor := clLtGr ay; | |
| 2067 | en d | |
| 2068 | el se if _min <> -1 the n | |
| 2069 | be gin | |
| 2070 | // All dat es between | |
| 2071 | if DateOf( DteToChk) < DateOf(F loatToDate Time(_min) ) then | |
| 2072 | UseColor := clLtGr ay; | |
| 2073 | en d | |
| 2074 | el se if _max <> -1 the n | |
| 2075 | be gin | |
| 2076 | // All dat es between | |
| 2077 | if DateOf( DteToChk) > DateOf(F loatToDate Time(_max) ) then | |
| 2078 | UseColor := clLtGr ay; | |
| 2079 | en d; | |
| 2080 | Br ush.Color := UseColo r; | |
| 2081 | end; | |
| 2082 | end; | |
| 2083 | Decode Date(Date, CurYear, CurMonth, CurDay); | |
| 2084 | if (Cu rYear = Ye ar) and (C urMonth = Month) and (IntToStr (CurDay) = TheText) | |
| 2085 | then | |
| 2086 | begin | |
| 2087 | TheT ext := '[' + TheText + ']'; | |
| 2088 | Font .Style := [fsBold]; | |
| 2089 | end; | |
| 2090 | ||
| 2091 | Font.C olor := In verseColor (Brush.Col or); | |
| 2092 | ||
| 2093 | TextRe ct(ARect, Left + (Ri ght - Left - TextWid th(TheText )) div 2, | |
| 2094 | Top + (Bottom - Top - Te xtHeight(T heText)) d iv 2, TheT ext); | |
| 2095 | end; | |
| 2096 | end; | |
| 2097 | ||
| 2098 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ---- Begin | |
| 2099 | ||
| 2100 | /// ////// ////////// ////////// ////////// ////////// ////////// ////////// ////////// / | |
| 2101 | constructo r TDateRan ge.Create; | |
| 2102 | begin | |
| 2103 | inherite d; | |
| 2104 | fMinDate := -1; | |
| 2105 | fMaxDate := -1; | |
| 2106 | end; | |
| 2107 | ||
| 2108 | procedure TDateRange .SetMinDat e(Const aM inDte: Dou ble); | |
| 2109 | begin | |
| 2110 | if (fMax Date <> -1 ) and (aMi nDte > fMa xDate) the n | |
| 2111 | begin | |
| 2112 | raise Exception. Create('Mi n date can not be aft er Max dat e'); | |
| 2113 | exit; | |
| 2114 | end; | |
| 2115 | fMinDate := aMinDt e; | |
| 2116 | end; | |
| 2117 | ||
| 2118 | procedure TDateRange .SetMaxDat e(const aM axDte: Dou ble); | |
| 2119 | begin | |
| 2120 | if (fMin Date <> -1 ) and (aMa xDte < fMi nDate) the n | |
| 2121 | begin | |
| 2122 | raise Exception. Create('Ma x date can not be bef ore Min da te'); | |
| 2123 | exit; | |
| 2124 | end; | |
| 2125 | fMaxDate := aMaxDt e; | |
| 2126 | end; | |
| 2127 | ||
| 2128 | function T DateRange. IsBetweenM inAndMax(c onst Looku pDate: TDa teTime): B oolean; | |
| 2129 | var | |
| 2130 | dd, ddd, dt: TDate Time; | |
| 2131 | begin | |
| 2132 | dt := Lo okupDate; | |
| 2133 | dd := fM inDate; | |
| 2134 | ddd := f MaxDate; | |
| 2135 | Result : = (dt >= d d) and (dt <= ddd); | |
| 2136 | // Resul t := (dt > = DateOf(f MinDate)) and (dt <= DateOf(fM axDate)); | |
| 2137 | end; | |
| 2138 | ||
| 2139 | function T DateRange. IsFullDay( const aDat e: TDateTi me): Boole an; | |
| 2140 | var | |
| 2141 | _min, _m ax, dtMin, dtMax: TD ateTime; | |
| 2142 | begin | |
| 2143 | _min := TDateTime( MinDate); | |
| 2144 | _max := TDateTime( MaxDate); | |
| 2145 | dtMin := round(aDa te) + 1 / (24 * 60 * 60); | |
| 2146 | dtMax := round(aDa te + 1) - 1 / (24 * 60 * 60); | |
| 2147 | Result : = (_min < dtMin) and (dtMax < _max); | |
| 2148 | end; | |
| 2149 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ------ End | |
| 2150 | ||
| 2151 | initializa tion | |
| 2152 | ||
| 2153 | uServerTod ay := 0; | |
| 2154 | FormatSett ings := TF ormatSetti ngs.Create ; | |
| 2155 | ||
| 2156 | end. |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.