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