Produced by Araxis Merge on 5/10/2019 1:00:03 PM Eastern 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 | CPRS_v32_64_P2.zip\OR_30_405V64_SRC.zip\10_2\OR\Source | ORDtTm.pas | Wed Apr 3 19:32:34 2019 UTC |
2 | CPRS_v32_64_P2.zip\OR_30_405V64_SRC.zip\10_2\OR\Source | ORDtTm.pas | Thu May 9 14:35:47 2019 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 2 | 4312 |
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 | ca ption := ' Select Dat e'; | |
834 | tx tTime.Visi ble := Fal se; | |
835 | ls tHour.Visi ble := Fal se; | |
836 | ls tMinute.Vi sible := F alse; | |
837 | cm dNow.Visib le := Fals e; | |
838 | cm dMidnight. Visible := False; | |
839 | bv lFrame.Wid th := bvlF rame.Width - txtTime .Width - H ORZ_SPACIN G; | |
840 | cm dOK.Left : = cmdOK.Le ft - txtTi me.Width - HORZ_SPAC ING; | |
841 | cm dCancel.Le ft := cmdO K.Left; | |
842 | Cl ientWidth := ClientW idth - txt Time.Width - HORZ_SP ACING; | |
843 | end; | |
844 | Resu lt := (Sho wModal = I DOK); | |
845 | if R esult then | |
846 | begi n | |
847 | FD ateTime := Int(calSe lect.Calen darDate); | |
848 | if Length(tx tTime.Text ) > 0 then | |
849 | FDateTime := FDateTi me + StrTo Time(txtTi me.Text); | |
850 | if FNowPress ed then | |
851 | FRelativeT ime := 'NO W' | |
852 | el se | |
853 | FRelativeT ime := Rel ativeDateT ime(FDateT ime); | |
854 | end; | |
855 | end; | |
856 | finally | |
857 | frmDtT m.Free; | |
858 | end; | |
859 | end; | |
860 | ||
861 | function T ORDateTime Dlg.GetFMD ateTime: T FMDateTime ; | |
862 | begin | |
863 | Result : = DateTime ToFMDateTi me(FDateTi me); | |
864 | end; | |
865 | ||
866 | procedure TORDateTim eDlg.SetDa teOnly(Val ue: Boolea n); | |
867 | begin | |
868 | FDateOnl y := Value ; | |
869 | if FDate Only then | |
870 | begin | |
871 | FRequi reTime := False; | |
872 | FDateT ime := Int (FDateTime ); | |
873 | end; | |
874 | end; | |
875 | ||
876 | procedure TORDateTim eDlg.SetFM DateTime(V alue: TFMD ateTime); | |
877 | begin | |
878 | if Value > 0 then | |
879 | FDateT ime := FMD ateTimeToD ateTime(Va lue); | |
880 | end; | |
881 | ||
882 | procedure TORDateTim eDlg.SetRe quireTime( Value: Boo lean); | |
883 | begin | |
884 | FRequire Time := Va lue; | |
885 | if FRequ ireTime th en | |
886 | FDateO nly := Fal se; | |
887 | end; | |
888 | ||
889 | { TORDateE dit ------ ---------- ---------- ---------- ---------- ---------- ---------- ---------- - } | |
890 | ||
891 | procedure TORDateEdi t.CreatePa rams(var P arams: TCr eateParams ); | |
892 | { sets a o ne line ed it box to multiline style so t he editing rectangle can be ch anged } | |
893 | begin | |
894 | inherite d CreatePa rams(Param s); | |
895 | Params.S tyle := Pa rams.Style or ES_MUL TILINE or WS_CLIPCHI LDREN; | |
896 | end; | |
897 | ||
898 | { TORDateB ox ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- --- } | |
899 | ||
900 | constructo r TORDateB ox.Create( AOwner: TC omponent); | |
901 | begin | |
902 | inherite d Create(A Owner); | |
903 | FButton := TORDate Button.Cre ate(self); | |
904 | FButton. Parent := self; | |
905 | FButton. Width := 1 8; | |
906 | FButton. Height := 17; | |
907 | FButton. OnClick := ButtonCli ck; | |
908 | // blj 1 9 Sept 201 7 JAZZ 329 927 - We h ave to be able to se t focus to the butto n using | |
909 | // Dragon bef ore we can pop the d ialog and worry abou t whether or not we can use | |
910 | // Dragon to move forwa rd or back wards a mo nth. | |
911 | FButton. TabStop := true; | |
912 | FBlackCo lorMode := False; | |
913 | LoadElli psis(FButt on.Glyph, False); | |
914 | FButton. Visible := True; | |
915 | FFormat := FMT_DAT ETIME; | |
916 | fDateRan ge := TDat eRange.Cre ate; // NS R20071216 AA 2016-01 -22 | |
917 | end; | |
918 | ||
919 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ---- Begin | |
920 | destructor TORDateBo x.Destroy( ); | |
921 | begin | |
922 | inherite d; | |
923 | fDateRan ge.Free; | |
924 | end; | |
925 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ------ End | |
926 | ||
927 | procedure TORDateBox .WMSize(va r Message: TWMSize); | |
928 | var | |
929 | ofs: Int eger; | |
930 | ||
931 | begin | |
932 | inherite d; | |
933 | if Assig ned(FButto n) then | |
934 | begin | |
935 | if Bor derStyle = bsNone th en | |
936 | ofs := 0 | |
937 | else | |
938 | ofs := 4; | |
939 | FButto n.SetBound s(Width - FButton.Wi dth - ofs, 0, FButto n.Width, | |
940 | Heig ht - ofs); | |
941 | end; | |
942 | SetEditR ect; | |
943 | end; | |
944 | ||
945 | procedure TORDateBox .SetTempla teField(co nst Value: Boolean); | |
946 | var | |
947 | Y: Integ er; | |
948 | ||
949 | begin | |
950 | if (FTem plateField <> Value) then | |
951 | begin | |
952 | FTempl ateField : = Value; | |
953 | Y := T extHeightB yFont(Font .Handle, F ontHeightT ext); | |
954 | if Val ue then | |
955 | begin | |
956 | FBut ton.Width := Y + 2; | |
957 | Heig ht := Y; | |
958 | Bord erStyle := bsNone; | |
959 | end | |
960 | else | |
961 | begin | |
962 | FBut ton.Width := 18; | |
963 | Heig ht := Y + AdjVertSiz e; | |
964 | Bord erStyle := bsSingle; | |
965 | end; | |
966 | end; | |
967 | end; | |
968 | ||
969 | function T ORDateBox. SupportsDy namicPrope rty(Proper tyID: Inte ger): Bool ean; | |
970 | begin | |
971 | Result : = (Propert yID = Dyna PropAccesi bilityCapt ion); | |
972 | end; | |
973 | ||
974 | procedure TORDateBox .ButtonCli ck(Sender: TObject); | |
975 | var | |
976 | DateDial og: TORDat eTimeDlg; | |
977 | ParsedDa te: TFMDat eTime; | |
978 | begin | |
979 | DateDial og := TORD ateTimeDlg .Create(Ap plication) ; | |
980 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- ------ Beg in | |
981 | DateDial og.DateRan ge := Date Range; | |
982 | if DateS elected <> 0 then // RTC item # 322517 ( 20160518) | |
983 | DateDial og.DateTim e := DateS elected; | |
984 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- -------- E nd | |
985 | if Lengt h(Text) > 0 then | |
986 | begin | |
987 | Parsed Date := Se rverParseF MDate(Text ); | |
988 | if Par sedDate > -1 then | |
989 | FFMD ateTime := ParsedDat e | |
990 | else | |
991 | FFMD ateTime := 0; | |
992 | end; | |
993 | DateDial og.DateOnl y := FDate Only; | |
994 | DateDial og.FMDateT ime := FFM DateTime; | |
995 | DateDial og.Require Time := FR equireTime ; | |
996 | ||
997 | if DateD ialog.Exec ute then | |
998 | begin | |
999 | FFMDat eTime := D ateDialog. FMDateTime ; | |
1000 | Update Text; | |
1001 | FTimeI sNow := Da teDialog.R elativeTim e = 'NOW'; | |
1002 | fDateS elected := DateDialo g.DateTime ; // NSR20 071216 AA 2016-01-22 | |
1003 | end; | |
1004 | DateDial og.Free; | |
1005 | if Assig ned(OnDate DialogClos ed) then | |
1006 | OnDate DialogClos ed(self); | |
1007 | if Visib le and Ena bled and n ot (csDest roying in self.Compo nentState) then // S ome events may hide the compon ent | |
1008 | SetFoc us; | |
1009 | end; | |
1010 | ||
1011 | procedure TORDateBox .Change; | |
1012 | begin | |
1013 | inherite d Change; | |
1014 | FTimeIsN ow := Fals e; | |
1015 | end; | |
1016 | ||
1017 | procedure TORDateBox .KeyDown(v ar Key: Wo rd; Shift: TShiftSta te); | |
1018 | begin | |
1019 | inherite d KeyDown( Key, Shift ); | |
1020 | if (Key = VK_RETUR N) then | |
1021 | begin | |
1022 | FButto n.Click; | |
1023 | Key := 0; | |
1024 | end; | |
1025 | end; | |
1026 | ||
1027 | procedure TORDateBox .KeyPress( var Key: C har); | |
1028 | begin | |
1029 | if Key = #13 then | |
1030 | Key := #0; | |
1031 | inherite d; | |
1032 | end; | |
1033 | ||
1034 | function T ORDateBox. GetFMDateT ime: TFMDa teTime; | |
1035 | begin | |
1036 | Result : = 0; | |
1037 | if Lengt h(Text) > 0 then | |
1038 | Result := Server ParseFMDat e(Text); | |
1039 | FFMDateT ime := Res ult; | |
1040 | end; | |
1041 | ||
1042 | function T ORDateBox. GetRelativ eTime: str ing; | |
1043 | begin | |
1044 | Result : = ''; | |
1045 | if FTime IsNow then | |
1046 | Result := 'NOW' | |
1047 | else if UpperCase( Text) = 'N OW' then | |
1048 | Result := 'NOW' | |
1049 | else if Length(Tex t) > 0 the n | |
1050 | begin | |
1051 | FFMDat eTime := S erverParse FMDate(Tex t); | |
1052 | if FFM DateTime > 0 then | |
1053 | Resu lt := Rela tiveDateTi me(FMDateT imeToDateT ime(FFMDat eTime)); | |
1054 | end; | |
1055 | end; | |
1056 | ||
1057 | procedure TORDateBox .SetDateOn ly(Value: Boolean); | |
1058 | begin | |
1059 | FDateOnl y := Value ; | |
1060 | if FDate Only then | |
1061 | begin | |
1062 | FRequi reTime := False; | |
1063 | FFMDat eTime := I nt(FFMDate Time); | |
1064 | if FFo rmat = FMT _DATETIME then | |
1065 | FFor mat := FMT _DATEONLY; | |
1066 | end; | |
1067 | UpdateTe xt; | |
1068 | end; | |
1069 | ||
1070 | procedure TORDateBox .SetFMDate Time(Value : TFMDateT ime); | |
1071 | begin | |
1072 | FFMDateT ime := Val ue; | |
1073 | UpdateTe xt; | |
1074 | end; | |
1075 | ||
1076 | procedure TORDateBox .SetRequir eTime(Valu e: Boolean ); | |
1077 | begin | |
1078 | FRequire Time := Va lue; | |
1079 | if FRequ ireTime th en | |
1080 | begin | |
1081 | if FFo rmat = FMT _DATEONLY then | |
1082 | FFor mat := FMT _DATETIME; | |
1083 | SetDat eOnly(Fals e); | |
1084 | end; | |
1085 | end; | |
1086 | ||
1087 | procedure TORDateBox .SetEditRe ct; | |
1088 | { change t he edit re ctangle to not hide the calend ar button - taken fr om SPIN.PA S sample } | |
1089 | var | |
1090 | Loc: TRe ct; | |
1091 | begin | |
1092 | SendMess age(Handle , EM_GETRE CT, 0, Lon gint(@Loc) ); | |
1093 | Loc.Bott om := Clie ntHeight + 1; // +1 is workaro und for wi ndows pain t bug | |
1094 | Loc.Righ t := FButt on.Left - 2; | |
1095 | Loc.Top := 0; | |
1096 | Loc.Left := 0; | |
1097 | SendMess age(Handle , EM_SETRE CTNP, 0, L ongint(@Lo c)); | |
1098 | end; | |
1099 | ||
1100 | procedure TORDateBox .UpdateTex t; | |
1101 | begin | |
1102 | if FFMDa teTime > 0 then | |
1103 | begin | |
1104 | if (FF ormat = FM T_DATETIME ) and (Fra c(FFMDateT ime) = 0) then | |
1105 | Text := Format FMDateTime (FMT_DATEO NLY, FFMDa teTime) | |
1106 | else | |
1107 | Text := Format FMDateTime (FFormat, FFMDateTim e); | |
1108 | end; | |
1109 | end; | |
1110 | ||
1111 | procedure TORDateBox .Validate( var ErrMsg : string); | |
1112 | var | |
1113 | dt: TDat eTime; | |
1114 | const | |
1115 | fmtDT = 'mm/dd/yyy y hh:nn:ss '; | |
1116 | begin | |
1117 | ErrMsg : = ''; | |
1118 | if Lengt h(Text) > 0 then | |
1119 | begin | |
1120 | { | |
1121 | !!!!!! THI S HAS BEEN REMOVED A S IT CAUSE D PROBLEMS WITH REMI NDER DIALO GS - DN S
|
|
1122 | //We need to m ake sure t hat there is a date entered be fore parse | |
1123 | if F RequireTim e and ((Po s('@', Tex t) = 0) or (Length(P iece(Text, '@', 1)) = 0)) then | |
1124 | ErrM sg := 'Dat e Required '; | |
1125 | } | |
1126 | FFMDat eTime := S erverParse FMDate(Tex t); | |
1127 | if FFM DateTime < = 0 then | |
1128 | ErrM sg := 'Inv alid Date/ Time'; | |
1129 | if FRe quireTime and (Frac( FFMDateTim e) = 0) th en | |
1130 | ErrM sg := ErrM sg + 'Time Required' + CRLF; | |
1131 | if FDa teOnly and (Frac(FFM DateTime) > 0) then | |
1132 | ErrM sg := ErrM sg + 'Time not Requi red' + CRL F; | |
1133 | ||
1134 | dt := FMDateTime ToDateTime (FFMDateTi me); | |
1135 | ||
1136 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
1137 | if (fD ateRange.M inDate > 0 ) and (dt < fDateRan ge.MinDate ) then | |
1138 | ErrM sg := ErrM sg + 'Date /Time sele cted (' + FormatDate Time(fmtDT , dt) + | |
1139 | ' )' + CRLF + 'can''t be less th an ' + For matDateTim e(fmtDT, | |
1140 | fD ateRange.M inDate) + CRLF; | |
1141 | if (fD ateRange.M axDate > 0 ) and (dt > fDateRan ge.MaxDate ) then | |
1142 | ErrM sg := ErrM sg + 'Date /Time sele cted (' + FormatDate Time(fmtDT , dt) + | |
1143 | ') ' + CRLF + 'can''t b e greater than ' + F ormatDateT ime(fmtDT, | |
1144 | fD ateRange.M axDate) + CRLF; | |
1145 | {$IFDEF DE BUG_AA} | |
1146 | if Err Msg <> '' then | |
1147 | ErrM sg := Name + ': ' + ErrMsg; | |
1148 | {$ENDIF} | |
1149 | ErrMsg := Trim(E rrMsg); | |
1150 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
1151 | end; | |
1152 | end; | |
1153 | ||
1154 | function T ORDateBox. IsValid: B oolean; | |
1155 | var | |
1156 | X: strin g; | |
1157 | begin | |
1158 | Validate (X); | |
1159 | Result : = (Length( X) = 0); | |
1160 | if (Leng th(Text) = 0) then | |
1161 | Result := False; | |
1162 | end; | |
1163 | ||
1164 | procedure TORDateBox .SetBlackC olorMode(V alue: Bool ean); | |
1165 | begin | |
1166 | if FBlac kColorMode <> Value then | |
1167 | begin | |
1168 | FBlack ColorMode := Value; | |
1169 | LoadEl lipsis(FBu tton.Glyph , FBlackCo lorMode); | |
1170 | end; | |
1171 | end; | |
1172 | ||
1173 | procedure TORDateBox .SetCaptio n(const Va lue: strin g); | |
1174 | begin | |
1175 | if not A ssigned(FC aption) th en | |
1176 | begin | |
1177 | FCapti on := TSta ticText.Cr eate(self) ; | |
1178 | FCapti on.AutoSiz e := False ; | |
1179 | FCapti on.Height := 0; | |
1180 | FCapti on.Width : = 0; | |
1181 | FCapti on.Visible := True; | |
1182 | FCapti on.Parent := Parent; | |
1183 | FCapti on.Bringto Front; | |
1184 | end; | |
1185 | FCaption .Caption : = Value; | |
1186 | end; | |
1187 | ||
1188 | procedure TORDateBox .SetEnable d(Value: B oolean); | |
1189 | begin | |
1190 | FButton. Enabled := Value; | |
1191 | inherite d; | |
1192 | end; | |
1193 | ||
1194 | function T ORDateBox. GetCaption : string; | |
1195 | begin | |
1196 | Result : = FCaption .Caption; | |
1197 | end; | |
1198 | ||
1199 | function T ORDateBox. GetDynamic Property(P ropertyID: Integer): string; | |
1200 | begin | |
1201 | if Prope rtyID = Dy naPropAcce sibilityCa ption then | |
1202 | Result := GetCap tion | |
1203 | else | |
1204 | Result := ''; | |
1205 | end; | |
1206 | ||
1207 | function I sLeapYear( AYear: Int eger): Boo lean; | |
1208 | begin | |
1209 | Result : = (AYear m od 4 = 0) and ((AYea r mod 100 <> 0) or ( AYear mod 400 = 0)); | |
1210 | end; | |
1211 | ||
1212 | function D aysPerMont h(AYear, A Month: Int eger): Int eger; | |
1213 | const | |
1214 | DaysInMo nth: array [1 .. 12] of Intege r = (31, 2 8, 31, 30, 31, 30, 3 1, 31, 30, | |
1215 | 31, 30 , 31); | |
1216 | begin | |
1217 | if (AYea r < 1) or (AMonth < 1) then | |
1218 | Result := 0 | |
1219 | else | |
1220 | begin | |
1221 | Result := DaysIn Month[AMon th]; | |
1222 | if (AM onth = 2) and IsLeap Year(AYear ) then | |
1223 | Inc( Result); { leap-year Feb is sp ecial } | |
1224 | end; | |
1225 | end; | |
1226 | ||
1227 | { TORDateC ombo ----- ---------- ---------- ---------- ---------- ---------- ---------- -------- } | |
1228 | ||
1229 | const | |
1230 | ComboBox AdjSize = 24; | |
1231 | EditAdjH orzSize = 8; | |
1232 | DateComb oCtrlGap = 2; | |
1233 | FirstYea r = 1800; | |
1234 | LastYear = 2200; | |
1235 | ||
1236 | { TORDat eComboEdit } | |
1237 | ||
1238 | procedure TORYearEdi t.SetTempl ateField(c onst Value : Boolean) ; | |
1239 | begin | |
1240 | if (FTem plateField <> Value) then | |
1241 | begin | |
1242 | FTempl ateField : = Value; | |
1243 | if Val ue then | |
1244 | Bord erStyle := bsNone | |
1245 | else | |
1246 | Bord erStyle := bsSingle; | |
1247 | end; | |
1248 | end; | |
1249 | ||
1250 | { TORDateC ombo } | |
1251 | ||
1252 | constructo r TORDateC ombo.Creat e(AOwner: TComponent ); | |
1253 | begin | |
1254 | inherite d; | |
1255 | ControlS tyle := Co ntrolStyle - [csSetC aption, cs AcceptsCon trols]; | |
1256 | BevelOut er := bvNo ne; | |
1257 | FInclude Month := T rue; | |
1258 | FInclude Day := Tru e; | |
1259 | FInclude Btn := Tru e; | |
1260 | OnResize := Resize d; | |
1261 | FORYearE ditClass : = TORYearE dit; | |
1262 | end; | |
1263 | ||
1264 | destructor TORDateCo mbo.Destro y; | |
1265 | begin | |
1266 | if Assig ned(FMonth Combo) the n | |
1267 | FMonth Combo.Free ; | |
1268 | if Assig ned(FDayCo mbo) then | |
1269 | FDayCo mbo.Free; | |
1270 | if Assig ned(FYearE dit) then | |
1271 | FYearE dit.Free; | |
1272 | if Assig ned(FYearU D) then | |
1273 | FYearU D.Free; | |
1274 | if Assig ned(FCalBt n) then | |
1275 | FCalBt n.Free; | |
1276 | inherite d; | |
1277 | end; | |
1278 | ||
1279 | function T ORDateComb o.GetYearS ize: Integ er; | |
1280 | begin | |
1281 | Result : = TextWidt hByFont(Fo nt.Handle, '8888') + EditAdjHo rzSize; | |
1282 | end; | |
1283 | ||
1284 | function T ORDateComb o.InitDays (GetSize: Boolean): Integer; | |
1285 | var | |
1286 | dy: Inte ger; | |
1287 | begin | |
1288 | Result : = 0; | |
1289 | if (Assi gned(FDayC ombo)) the n | |
1290 | begin | |
1291 | dy := DaysPerMon th(FYear, FMonth) + 1; | |
1292 | while (FDayCombo .Items.Cou nt < dy) d o | |
1293 | begin | |
1294 | if ( FDayCombo. Items.Coun t = 0) the n | |
1295 | FD ayCombo.It ems.Add(' ') | |
1296 | else | |
1297 | FD ayCombo.It ems.Add(In tToStr(FDa yCombo.Ite ms.Count)) ; | |
1298 | end; | |
1299 | while (FDayCombo .Items.Cou nt > dy) d o | |
1300 | FDay Combo.Item s.Delete(F DayCombo.I tems.Count - 1); | |
1301 | if (Ge tSize) the n | |
1302 | Resu lt := Text WidthByFon t(Font.Han dle, '88') + ComboBo xAdjSize; | |
1303 | if (FD ay > (dy - 1)) then | |
1304 | SetD ay(dy - 1) ; | |
1305 | end; | |
1306 | end; | |
1307 | ||
1308 | function T ORDateComb o.InitMont hs(GetSize : Boolean) : Integer; | |
1309 | var | |
1310 | i, Size: Integer; | |
1311 | begin | |
1312 | Result : = 0; | |
1313 | if (Assi gned(FMont hCombo)) t hen | |
1314 | begin | |
1315 | FMonth Combo.Item s.Clear; | |
1316 | FMonth Combo.Item s.Add(' ') ; | |
1317 | for i := 1 to 12 do | |
1318 | begin | |
1319 | if F LongMonths then | |
1320 | FM onthCombo. Items.Add( FormatSett ings.LongM onthNames[ i]) | |
1321 | else | |
1322 | FM onthCombo. Items.Add( FormatSett ings.Short MonthNames [i]); | |
1323 | if G etSize the n | |
1324 | begi n | |
1325 | Si ze := Text WidthByFon t(Font.Han dle, FMont hCombo.Ite ms[i]); | |
1326 | if (Result < Size) the n | |
1327 | Result := Size; | |
1328 | end; | |
1329 | end; | |
1330 | if Get Size then | |
1331 | Inc( Result, Co mboBoxAdjS ize); | |
1332 | end; | |
1333 | end; | |
1334 | ||
1335 | procedure TORDateCom bo.Rebuild ; | |
1336 | var | |
1337 | Wide, X, Y: Intege r; | |
1338 | ||
1339 | begin | |
1340 | if (not FRebuildin g) then | |
1341 | begin | |
1342 | FRebui lding := T rue; | |
1343 | try | |
1344 | Cont rolStyle : = ControlS tyle + [cs AcceptsCon trols]; | |
1345 | try | |
1346 | Y := TextHei ghtByFont( Font.Handl e, FontHei ghtText); | |
1347 | if not FTemp lateField then | |
1348 | Inc(Y, Adj VertSize); | |
1349 | X := 0; | |
1350 | if (FInclude Month) the n | |
1351 | be gin | |
1352 | if (not As signed(FMo nthCombo)) then | |
1353 | begin | |
1354 | FMonthCo mbo := TOR MonthCombo .Create(se lf); | |
1355 | FMonthCo mbo.Parent := self; | |
1356 | FMonthCo mbo.Top := 0; | |
1357 | FMonthCo mbo.Left : = 0; | |
1358 | FMonthCo mbo.Style := orcsDro pDown; | |
1359 | FMonthCo mbo.DropDo wnCount := 13; | |
1360 | FMonthCo mbo.ListIt emsOnly := True; | |
1361 | FMonthCo mbo.OnChan ge := Mont hChanged; | |
1362 | end; | |
1363 | FMonthComb o.Font := Font; | |
1364 | FMonthComb o.Template Field := F TemplateFi eld; | |
1365 | Wide := In itMonths(T rue); | |
1366 | FMonthComb o.Width := Wide; | |
1367 | FMonthComb o.Height : = Y; | |
1368 | FMonthComb o.ItemInde x := FMont h; | |
1369 | Inc(X, Wid e + DateCo mboCtrlGap ); | |
1370 | ||
1371 | if (FInclu deDay) the n | |
1372 | begin | |
1373 | if (not Assigned(F DayCombo)) then | |
1374 | begin | |
1375 | FDayCo mbo := TOR DayCombo.C reate(self ); | |
1376 | FDayCo mbo.Parent := self; | |
1377 | FDayCo mbo.Top := 0; | |
1378 | FDayCo mbo.Style := orcsDro pDown; | |
1379 | FDayCo mbo.ListIt emsOnly := True; | |
1380 | FDayCo mbo.OnChan ge := DayC hanged; | |
1381 | FDayCo mbo.DropDo wnCount := 11; | |
1382 | end; | |
1383 | FDayComb o.Font := Font; | |
1384 | FDayComb o.Template Field := F TemplateFi eld; | |
1385 | Wide := InitDays(T rue); | |
1386 | FDayComb o.Width := Wide; | |
1387 | FDayComb o.Height : = Y; | |
1388 | FDayComb o.Left := X; | |
1389 | FDayComb o.ItemInde x := FDay; | |
1390 | Inc(X, W ide + Date ComboCtrlG ap); | |
1391 | end | |
1392 | else if As signed(FDa yCombo) th en | |
1393 | begin | |
1394 | FDayComb o.Free; | |
1395 | FDayComb o := nil; | |
1396 | end; | |
1397 | en d | |
1398 | el se | |
1399 | be gin | |
1400 | if Assigne d(FDayComb o) then | |
1401 | begin | |
1402 | FDayComb o.Free; | |
1403 | FDayComb o := nil; | |
1404 | end; | |
1405 | if Assigne d(FMonthCo mbo) then | |
1406 | begin | |
1407 | FMonthCo mbo.Free; | |
1408 | FMonthCo mbo := nil ; | |
1409 | end; | |
1410 | en d; | |
1411 | if (not Assi gned(FYear Edit)) the n | |
1412 | be gin | |
1413 | FYearEdit := FORYear EditClass. Create(sel f); | |
1414 | FYearEdit. Parent := self; | |
1415 | FYearEdit. Top := 0; | |
1416 | FYearEdit. EditMask : = '9999;1; '; | |
1417 | FYearEdit. OnKeyPress := YearKe yPress; | |
1418 | FYearEdit. OnChange : = YearChan ged; | |
1419 | en d; | |
1420 | FY earEdit.Fo nt := Font ; | |
1421 | FY earEdit.Te mplateFiel d := FTemp lateField; | |
1422 | Wi de := GetY earSize; | |
1423 | FY earEdit.Wi dth := Wid e; | |
1424 | FY earEdit.He ight := Y; | |
1425 | FY earEdit.Le ft := X; | |
1426 | In c(X, Wide) ; | |
1427 | if (not Assi gned(FYear UD)) then | |
1428 | be gin | |
1429 | FYearUD := TUpDown.C reate(self ); | |
1430 | FYearUD.Pa rent := se lf; | |
1431 | FYearUD.Th ousands := False; | |
1432 | FYearUD.Mi n := First Year - 1; | |
1433 | FYearUD.Ma x := LastY ear; | |
1434 | FYearUD.On ChangingEx := YearUD Change; | |
1435 | en d; | |
1436 | FY earEdit.Ta bOrder := 0; | |
1437 | FY earUD.Top := 0; | |
1438 | FY earUD.Left := X; | |
1439 | FY earUD.Heig ht := Y; | |
1440 | FY earUD.Posi tion := FY ear; | |
1441 | In c(X, FYear UD.Width + DateCombo CtrlGap); | |
1442 | if (FInclude Btn) then | |
1443 | be gin | |
1444 | if (not As signed(FCa lBtn)) the n | |
1445 | begin | |
1446 | FCalBtn := TORDate Button.Cre ate(self); | |
1447 | FCalBtn. TabStop := False; | |
1448 | FCalBtn. Parent := self; | |
1449 | FCalBtn. Top := 0; | |
1450 | LoadElli psis(FCalB tn.Glyph, FBlackColo rMode); | |
1451 | FCalBtn. OnClick := BtnClicke d; | |
1452 | end; | |
1453 | Wide := FY earEdit.He ight; | |
1454 | if (Wide > Y) then | |
1455 | Wide := Y; | |
1456 | FCalBtn.Wi dth := Wid e; | |
1457 | FCalBtn.He ight := Wi de; | |
1458 | FCalBtn.Le ft := X; | |
1459 | Inc(X, Wid e + DateCo mboCtrlGap ); | |
1460 | en d | |
1461 | el se if Assi gned(FCalB tn) then | |
1462 | be gin | |
1463 | FCalBtn.Fr ee; | |
1464 | FCalBtn := nil; | |
1465 | en d; | |
1466 | se lf.Width : = X - Date ComboCtrlG ap; | |
1467 | se lf.Height := Y; | |
1468 | Ch eckDays; | |
1469 | FC trlsCreate d := True; | |
1470 | Do Change; | |
1471 | fina lly | |
1472 | Co ntrolStyle := Contro lStyle - [ csAcceptsC ontrols]; | |
1473 | end; | |
1474 | finall y | |
1475 | FReb uilding := False; | |
1476 | end; | |
1477 | end; | |
1478 | end; | |
1479 | ||
1480 | procedure TORDateCom bo.SetBlac kColorMode (Value: Bo olean); | |
1481 | begin | |
1482 | if FBlac kColorMode <> Value then | |
1483 | begin | |
1484 | FBlack ColorMode := Value; | |
1485 | if Ass igned(FCal Btn) then | |
1486 | Load Ellipsis(F CalBtn.Gly ph, FBlack ColorMode) ; | |
1487 | end; | |
1488 | end; | |
1489 | ||
1490 | procedure TORDateCom bo.SetDay( Value: Int eger); | |
1491 | begin | |
1492 | if (not Assigned(F DayCombo)) and (not( csLoading in Compone ntState)) then | |
1493 | Value := 0; | |
1494 | if (Valu e > DaysPe rMonth(FYe ar, FMonth )) then | |
1495 | Value := 0; | |
1496 | if (FDay <> Value) then | |
1497 | begin | |
1498 | FDay : = Value; | |
1499 | if (As signed(FDa yCombo)) t hen | |
1500 | begin | |
1501 | if ( FDayCombo. Items.Coun t <= FDay) then | |
1502 | In itDays(Fal se); | |
1503 | FDay Combo.Item Index := F Day; | |
1504 | end; | |
1505 | DoChan ge; | |
1506 | end; | |
1507 | end; | |
1508 | ||
1509 | procedure TORDateCom bo.SetIncl udeBtn(con st Value: Boolean); | |
1510 | begin | |
1511 | if (FInc ludeBtn <> Value) th en | |
1512 | begin | |
1513 | FInclu deBtn := V alue; | |
1514 | Rebuil d; | |
1515 | end; | |
1516 | end; | |
1517 | ||
1518 | procedure TORDateCom bo.SetIncl udeDay(Val ue: Boolea n); | |
1519 | begin | |
1520 | if (Valu e) and (no t FInclude Month) the n | |
1521 | Value := False; | |
1522 | if (FInc ludeDay <> Value) th en | |
1523 | begin | |
1524 | FInclu deDay := V alue; | |
1525 | if (no t Value) t hen | |
1526 | FDay := 0; | |
1527 | Rebuil d; | |
1528 | end; | |
1529 | end; | |
1530 | ||
1531 | procedure TORDateCom bo.SetIncl udeMonth(c onst Value : Boolean) ; | |
1532 | begin | |
1533 | if (FInc ludeMonth <> Value) then | |
1534 | begin | |
1535 | FInclu deMonth := Value; | |
1536 | if (no t Value) t hen | |
1537 | begin | |
1538 | FInc ludeDay := False; | |
1539 | FMon th := 0; | |
1540 | FDay := 0; | |
1541 | end; | |
1542 | Rebuil d; | |
1543 | end; | |
1544 | end; | |
1545 | ||
1546 | procedure TORDateCom bo.SetMont h(Value: I nteger); | |
1547 | begin | |
1548 | if (not Assigned(F MonthCombo )) and (no t(csLoadin g in Compo nentState) ) then | |
1549 | Value := 0; | |
1550 | if (Valu e < 0) or (Value > 1 2) then | |
1551 | Value := 0; | |
1552 | if (FMon th <> Valu e) then | |
1553 | begin | |
1554 | FMonth := Value; | |
1555 | if (As signed(FMo nthCombo)) then | |
1556 | FMon thCombo.It emIndex := FMonth; | |
1557 | CheckD ays; | |
1558 | DoChan ge; | |
1559 | end; | |
1560 | end; | |
1561 | ||
1562 | procedure TORDateCom bo.SetLong Months(con st Value: Boolean); | |
1563 | begin | |
1564 | if (FLon gMonths <> Value) th en | |
1565 | begin | |
1566 | FLongM onths := V alue; | |
1567 | Rebuil d; | |
1568 | end; | |
1569 | end; | |
1570 | ||
1571 | procedure TORDateCom bo.SetYear (const Val ue: Intege r); | |
1572 | begin | |
1573 | if (FYea r <> Value ) then | |
1574 | begin | |
1575 | FYear := Value; | |
1576 | if (FY ear < Firs tYear) or (FYear > L astYear) t hen | |
1577 | FYea r := 0; | |
1578 | if (no t FYearCha nging) and (Assigned (FYearEdit )) and (As signed(FYe arUD)) | |
1579 | then | |
1580 | begin | |
1581 | FYea rChanging := True; | |
1582 | try | |
1583 | if (FYear = 0) then | |
1584 | be gin | |
1585 | FYearEdit. Text := ' '; | |
1586 | FYearUD.Po sition := FirstYear - 1 | |
1587 | en d | |
1588 | el se | |
1589 | be gin | |
1590 | FYearEdit. Text := In tToStr(FYe ar); | |
1591 | FYearUD.Po sition := FYear; | |
1592 | en d; | |
1593 | fina lly | |
1594 | FY earChangin g := False ; | |
1595 | end; | |
1596 | end; | |
1597 | if (FM onth = 2) then | |
1598 | Init Days(False ); | |
1599 | CheckD ays; | |
1600 | DoChan ge; | |
1601 | end; | |
1602 | end; | |
1603 | ||
1604 | procedure TORDateCom bo.DayChan ged(Sender : TObject) ; | |
1605 | begin | |
1606 | FDay := FDayCombo. ItemIndex; | |
1607 | if (FDay < 0) then | |
1608 | FDay : = 0; | |
1609 | CheckDay s; | |
1610 | DoChange ; | |
1611 | end; | |
1612 | ||
1613 | procedure TORDateCom bo.MonthCh anged(Send er: TObjec t); | |
1614 | begin | |
1615 | FMonth : = FMonthCo mbo.ItemIn dex; | |
1616 | if (FMon th < 0) th en | |
1617 | FMonth := 0; | |
1618 | InitDays (False); | |
1619 | CheckDay s; | |
1620 | DoChange ; | |
1621 | end; | |
1622 | ||
1623 | procedure TORDateCom bo.YearCha nged(Sende r: TObject ); | |
1624 | begin | |
1625 | if FYear Changing t hen | |
1626 | exit; | |
1627 | FYearCha nging := T rue; | |
1628 | try | |
1629 | FYear := StrToIn tDef(FYear Edit.Text, 0); | |
1630 | if (FY ear < Firs tYear) or (FYear > L astYear) t hen | |
1631 | FYea r := 0; | |
1632 | if (FY ear = 0) t hen | |
1633 | FYea rUD.Positi on := Firs tYear - 1 | |
1634 | else | |
1635 | FYea rUD.Positi on := FYea r; | |
1636 | if (FM onth = 2) then | |
1637 | Init Days(False ); | |
1638 | CheckD ays; | |
1639 | DoChan ge; | |
1640 | finally | |
1641 | FYearC hanging := False; | |
1642 | end; | |
1643 | end; | |
1644 | ||
1645 | procedure TORDateCom bo.CheckDa ys; | |
1646 | var | |
1647 | MaxDays: Integer; | |
1648 | ||
1649 | begin | |
1650 | if (FInc ludeMonth and Assign ed(FMonthC ombo)) the n | |
1651 | begin | |
1652 | FMonth Combo.Enab led := (FY ear > 0); | |
1653 | if (FY ear = 0) t hen | |
1654 | SetM onth(0); | |
1655 | if (FI ncludeMont h and FInc ludeDay an d Assigned (FDayCombo )) then | |
1656 | begin | |
1657 | FDay Combo.Enab led := ((F Year > 0) and (FMont h > 0)); | |
1658 | MaxD ays := Day sPerMonth( FYear, FMo nth); | |
1659 | if ( FDay > Max Days) then | |
1660 | Se tDay(MaxDa ys); | |
1661 | end; | |
1662 | end; | |
1663 | end; | |
1664 | ||
1665 | procedure TORDateCom bo.Loaded; | |
1666 | begin | |
1667 | inherite d; | |
1668 | if (not FCtrlsCrea ted) then | |
1669 | Rebuil d; | |
1670 | end; | |
1671 | ||
1672 | procedure TORDateCom bo.Paint; | |
1673 | begin | |
1674 | if (not FCtrlsCrea ted) then | |
1675 | Rebuil d; | |
1676 | inherite d; | |
1677 | end; | |
1678 | ||
1679 | procedure TORDateCom bo.BtnClic ked(Sender : TObject) ; | |
1680 | var | |
1681 | mm, dd, yy: Intege r; | |
1682 | m, d, Y: Word; | |
1683 | DateDial og: TORDat eTimeDlg; | |
1684 | begin | |
1685 | DateDial og := TORD ateTimeDlg .Create(se lf); | |
1686 | try | |
1687 | mm := FMonth; | |
1688 | dd := FDay; | |
1689 | yy := FYear; | |
1690 | Decode Date(Now, Y, m, d); | |
1691 | if (FY ear = 0) t hen | |
1692 | FYea r := Y; | |
1693 | if (FY ear = Y) t hen | |
1694 | begin | |
1695 | if ( (FMonth = 0) or (FMo nth = m)) and (FDay = 0) then | |
1696 | begi n | |
1697 | FM onth := m; | |
1698 | FD ay := d; | |
1699 | end; | |
1700 | end; | |
1701 | if (FM onth = 0) then | |
1702 | FMon th := 1; | |
1703 | if (FD ay = 0) th en | |
1704 | FDay := 1; | |
1705 | DateDi alog.FMDat eTime := G etFMDate; | |
1706 | DateDi alog.DateO nly := Tru e; | |
1707 | DateDi alog.Requi reTime := False; | |
1708 | if Dat eDialog.Ex ecute then | |
1709 | begin | |
1710 | FYea r := 0; | |
1711 | FMon th := 0; | |
1712 | FDay := 0; | |
1713 | SetF MDate(Date Dialog.FMD ateTime); | |
1714 | end | |
1715 | else | |
1716 | begin | |
1717 | SetY ear(yy); | |
1718 | SetM onth(mm); | |
1719 | SetD ay(dd); | |
1720 | end; | |
1721 | finally | |
1722 | DateDi alog.Free; | |
1723 | end; | |
1724 | end; | |
1725 | ||
1726 | procedure TORDateCom bo.YearUDC hange(Send er: TObjec t; var All owChange: Boolean; | |
1727 | NewValue : Integer; Direction : TUpDownD irection); | |
1728 | var | |
1729 | Y, m, d: Word; | |
1730 | begin | |
1731 | if FYear Changing t hen | |
1732 | exit; | |
1733 | FYearCha nging := T rue; | |
1734 | try | |
1735 | if FYe arUD.Posit ion = (Fir stYear - 1 ) then | |
1736 | begin | |
1737 | Deco deDate(Now , Y, m, d) ; | |
1738 | FYea r := Y; | |
1739 | FYea rUD.Positi on := Y; | |
1740 | Allo wChange := False; | |
1741 | end | |
1742 | else | |
1743 | FYea r := NewVa lue; | |
1744 | if (FY ear < Firs tYear) or (FYear > L astYear) t hen | |
1745 | FYea r := 0; | |
1746 | if (FY ear = 0) t hen | |
1747 | FYea rEdit.Text := ' ' | |
1748 | else | |
1749 | FYea rEdit.Text := IntToS tr(FYear); | |
1750 | if (FM onth = 2) then | |
1751 | Init Days(False ); | |
1752 | CheckD ays; | |
1753 | DoChan ge; | |
1754 | finally | |
1755 | FYearC hanging := False; | |
1756 | end; | |
1757 | end; | |
1758 | ||
1759 | procedure TORDateCom bo.YearKey Press(Send er: TObjec t; var Key : Char); | |
1760 | begin | |
1761 | if CharI nSet(Key, ['0' .. '9 ']) and (F YearEdit.T ext = ' ') then | |
1762 | begin | |
1763 | FYearE dit.Text : = Key + ' '; | |
1764 | Key := #0; | |
1765 | FYearE dit.SelSta rt := 1; | |
1766 | FYearE dit.SelTex t := ''; | |
1767 | end; | |
1768 | end; | |
1769 | ||
1770 | function T ORDateComb o.GetFMDat e: TFMDate Time; | |
1771 | begin | |
1772 | if (FYea r < FirstY ear) then | |
1773 | Result := 0 | |
1774 | else | |
1775 | Result := ((FYea r - 1700) * 10000 + FMonth * 1 00 + FDay) ; | |
1776 | end; | |
1777 | ||
1778 | procedure TORDateCom bo.SetFMDa te(const V alue: TFMD ateTime); | |
1779 | var | |
1780 | ival, mo , dy: Inte ger; | |
1781 | begin | |
1782 | if (Valu e = 0) the n | |
1783 | begin | |
1784 | SetYea r(0); | |
1785 | SetMon th(0); | |
1786 | end | |
1787 | else | |
1788 | begin | |
1789 | ival : = Trunc(Va lue); | |
1790 | if (Le ngth(IntTo Str(ival)) <> 7) the n | |
1791 | exit ; | |
1792 | dy := (ival mod 100); | |
1793 | ival : = ival div 100; | |
1794 | mo := ival mod 1 00; | |
1795 | ival : = ival div 100; | |
1796 | SetYea r(ival + 1 700); | |
1797 | SetMon th(mo); | |
1798 | InitDa ys(False); | |
1799 | SetDay (dy); | |
1800 | end; | |
1801 | end; | |
1802 | ||
1803 | function T ORDateComb o.DateText : string; | |
1804 | begin | |
1805 | Result : = ''; | |
1806 | if (FYea r > 0) the n | |
1807 | begin | |
1808 | if (FM onth > 0) then | |
1809 | begin | |
1810 | if F LongMonths then | |
1811 | Re sult := Fo rmatSettin gs.LongMon thNames[FM onth] | |
1812 | else | |
1813 | Re sult := Fo rmatSettin gs.ShortMo nthNames[F Month]; | |
1814 | if ( FDay > 0) then | |
1815 | Re sult := Re sult + ' ' + IntToSt r(FDay); | |
1816 | Resu lt := Resu lt + ', '; | |
1817 | end; | |
1818 | Result := Result + IntToSt r(FYear); | |
1819 | end; | |
1820 | end; | |
1821 | ||
1822 | procedure TORDateCom bo.DoChang e; | |
1823 | begin | |
1824 | if Assig ned(FOnCha nge) then | |
1825 | FOnCha nge(self); | |
1826 | end; | |
1827 | ||
1828 | procedure TORDateCom bo.Resized (Sender: T Object); | |
1829 | begin | |
1830 | Rebuild; | |
1831 | end; | |
1832 | ||
1833 | procedure TORDateCom bo.CMFontC hanged(var Message: TMessage); | |
1834 | begin | |
1835 | inherite d; | |
1836 | Rebuild; | |
1837 | end; | |
1838 | ||
1839 | function T ORDateComb o.Text: st ring; | |
1840 | var | |
1841 | tmp, fmt , m: strin g; | |
1842 | begin | |
1843 | Result : = ''; | |
1844 | tmp := F loatToStr( FMDate); | |
1845 | if (tmp <> '') and (tmp <> ' 0') and (L ength(tmp) >= 7) the n | |
1846 | begin | |
1847 | if FLo ngMonths t hen | |
1848 | m := 'mmmm' | |
1849 | else | |
1850 | m := 'mmm'; | |
1851 | if (co py(tmp, 4, 4) = '000 0') then | |
1852 | fmt := 'yyyy' | |
1853 | else i f (copy(tm p, 6, 2) = '00') the n | |
1854 | fmt := m + ', YYYY' | |
1855 | else | |
1856 | fmt := m + ' D , YYYY'; | |
1857 | Result := Format FMDateTime Str(fmt, t mp) | |
1858 | end; | |
1859 | end; | |
1860 | ||
1861 | procedure Register; | |
1862 | { used by Delphi to put compon ents on th e Palette } | |
1863 | begin | |
1864 | Register Components ('CPRS', [ TORDateTim eDlg, TORD ateBox, TO RDateCombo ]); | |
1865 | end; | |
1866 | ||
1867 | procedure TORDateCom bo.SetTemp lateField( const Valu e: Boolean ); | |
1868 | begin | |
1869 | if FTemp lateField <> Value t hen | |
1870 | begin | |
1871 | FTempl ateField : = Value; | |
1872 | Rebuil d; | |
1873 | end; | |
1874 | end; | |
1875 | ||
1876 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ---- Begin | |
1877 | ||
1878 | Procedure TORDateCom bo.SetColo r(const Va lue: TColo r); | |
1879 | begin | |
1880 | fColor : = Value; | |
1881 | if Assig ned(FMonth Combo) the n | |
1882 | FMonth Combo.Colo r := fColo r; | |
1883 | if Assig ned(FDayCo mbo) then | |
1884 | FDayCo mbo.Color := fColor; | |
1885 | if Assig ned(FYearE dit) then | |
1886 | FYearE dit.Color := fColor; | |
1887 | end; | |
1888 | ||
1889 | { TORCalen dar ------ ---------- ---------- ---------- ---------- ---------- ---------- ---------- --- } | |
1890 | constructo r TORCalen dar.Create (AOwner: T Component) ; | |
1891 | begin | |
1892 | inherite d Create(A Owner); | |
1893 | end; | |
1894 | ||
1895 | destructor TORCalend ar.Destroy (); | |
1896 | begin | |
1897 | inherite d; | |
1898 | end; | |
1899 | ||
1900 | procedure TORCalenda r.KeyDown( var Key: W ord; Shift : TShiftSt ate); | |
1901 | var | |
1902 | iDelta: Integer; | |
1903 | begin | |
1904 | // inher ited; | |
1905 | if ssCtr l in Shift then | |
1906 | iDelta := 11 | |
1907 | else | |
1908 | iDelta := 0; | |
1909 | ||
1910 | if Key = VK_PRIOR then | |
1911 | begin | |
1912 | Calend arDate := IncMonth(C alendarDat e, -iDelta ); | |
1913 | if isR angeMode a nd (Calend arDate < M inDateTime ) then | |
1914 | Cale ndarDate : = MinDateT ime; | |
1915 | end | |
1916 | else if Key = VK_L EFT then | |
1917 | begin | |
1918 | Calend arDate := CalendarDa te - 1; | |
1919 | if isR angeMode a nd (Calend arDate < M inDateTime ) then | |
1920 | Cale ndarDate : = MinDateT ime; | |
1921 | end | |
1922 | else if Key = VK_N EXT then | |
1923 | begin | |
1924 | Calend arDate := IncMonth(C alendarDat e, iDelta) ; | |
1925 | if isR angeMode a nd (Calend arDate > M axDateTime ) then | |
1926 | Cale ndarDate : = MaxDateT ime; | |
1927 | end | |
1928 | else if Key = VK_R IGHT then | |
1929 | begin | |
1930 | Calend arDate := CalendarDa te + 1; | |
1931 | if isR angeMode a nd (Calend arDate > M axDateTime ) then | |
1932 | Cale ndarDate : = MaxDateT ime; | |
1933 | end; | |
1934 | end; | |
1935 | ||
1936 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ---- Begin | |
1937 | ||
1938 | procedure TORCalenda r.SetValid Range(aRan ge: TDateR ange); | |
1939 | begin | |
1940 | fValidRa nge := aRa nge; | |
1941 | if Valid Range.IsBe tweenMinAn dMax(Serve rToday) th en | |
1942 | Calend arDate := ServerToda y | |
1943 | else | |
1944 | Calend arDate := ValidRange .MinDate; | |
1945 | end; | |
1946 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ------ End | |
1947 | ||
1948 | function T ORCalendar .getMinDat eTime: TDa teTime; | |
1949 | begin | |
1950 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- ------ Beg in | |
1951 | if Assig ned(ValidR ange) then | |
1952 | Result := ValidR ange.MinDa te | |
1953 | else | |
1954 | Result := -1.0; | |
1955 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- -------- E nd | |
1956 | end; | |
1957 | ||
1958 | function T ORCalendar .getMaxDat eTime: TDa teTime; | |
1959 | begin | |
1960 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- ------ Beg in | |
1961 | if Assig ned(ValidR ange) then | |
1962 | Result := ValidR ange.MaxDa te | |
1963 | else | |
1964 | Result := -1.0; | |
1965 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- -------- E nd | |
1966 | end; | |
1967 | ||
1968 | function T ORCalendar .IsBetween MinAndMax( const Look upDate: TD ateTime): Boolean; | |
1969 | begin | |
1970 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- ------ Beg in | |
1971 | if Assig ned(ValidR ange) then | |
1972 | Result := ValidR ange.IsBet weenMinAnd Max(Lookup Date) | |
1973 | else | |
1974 | Result := True; | |
1975 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- -------- E nd | |
1976 | end; | |
1977 | ||
1978 | function T ORCalendar .isRangeMo de: boolea n; | |
1979 | begin | |
1980 | // fix for Defect #3 32950: | |
1981 | // Access violation in TORDate Combo comp onent on s electing t he date in the assoc iated Cale ndar form | |
1982 | Result : = Assigned (ValidRang e) and ( | |
1983 | (Valid Range.MaxD ate <> -1) or (Valid Range.MinD ate <> -1) | |
1984 | ); | |
1985 | end; | |
1986 | ||
1987 | function T ORCalendar .SelectCel l(ACol, AR ow: Longin t): Boolea n; | |
1988 | var | |
1989 | TheText: string; | |
1990 | DteToChk : TDateTim e; | |
1991 | _min, _m ax: TDateT ime; | |
1992 | begin | |
1993 | Result : = (Inherit ed); | |
1994 | ||
1995 | TheText := CellTex t[ACol, AR ow]; | |
1996 | if TheTe xt = '' th en | |
1997 | exit; | |
1998 | DteToChk := Encode Date(Year, Month, St rToIntDef( TheText, 0 )); | |
1999 | ||
2000 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- ------ Beg in | |
2001 | if Assig ned(ValidR ange) then | |
2002 | begin | |
2003 | if Res ult then | |
2004 | begin | |
2005 | _min := getMin DateTime; | |
2006 | _max := getMax DateTime; | |
2007 | if _ min <> -1 then | |
2008 | Re sult := Da teOf(DteTo Chk) >= Da teOf(Float ToDateTime (_min)); | |
2009 | if _ max <> -1 then | |
2010 | Re sult := Re sult and | |
2011 | (DateOf(Dt eToChk) <= DateOf(Fl oatToDateT ime(_max)) ); | |
2012 | end; | |
2013 | end; | |
2014 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- -------- E nd | |
2015 | end; | |
2016 | ||
2017 | function I nverseColo r(Color: T Color): TC olor; | |
2018 | var | |
2019 | rgb_: TC olorref; | |
2020 | ||
2021 | function Inv(b: By te): Byte; | |
2022 | begin | |
2023 | if b > 128 then | |
2024 | Resu lt := 0 | |
2025 | else | |
2026 | Resu lt := 255; | |
2027 | end; | |
2028 | ||
2029 | begin | |
2030 | rgb_ := ColorToRgb (Color); | |
2031 | rgb_ := RGB(Inv(Ge tRValue(rg b_)), Inv( GetGValue( rgb_)), In v(GetBValu e(rgb_))); | |
2032 | ||
2033 | Result : = rgb_; | |
2034 | end; | |
2035 | ||
2036 | procedure TORCalenda r.DrawCell (ACol, ARo w: Longint ; ARect: T Rect; | |
2037 | AState: TGridDrawS tate); | |
2038 | var | |
2039 | TheText: string; | |
2040 | DteToChk : TDateTim e; | |
2041 | CurMonth , CurYear, CurDay: W ord; | |
2042 | UseColor : TColor; | |
2043 | _min, _m ax: TDateT ime; | |
2044 | ||
2045 | begin | |
2046 | TheText := CellTex t[ACol, AR ow]; | |
2047 | with ARe ct, Canvas do | |
2048 | begin | |
2049 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
2050 | if Ass igned(Vali dRange) th en | |
2051 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
2052 | begin | |
2053 | _min := getMin DateTime; | |
2054 | _max := getMax DateTime; | |
2055 | ||
2056 | if S trToIntDef (TheText, -1) <> -1 then | |
2057 | begi n | |
2058 | Dt eToChk := EncodeDate (Year, Mon th, StrToI ntDef(TheT ext, 0)); | |
2059 | Us eColor := clWindow; | |
2060 | // if IsFull Day(DteToC hk) then | |
2061 | // UseColor := clLtGra y; | |
2062 | ||
2063 | if (_min <> -1) and (_ max <> -1) then | |
2064 | be gin | |
2065 | // All dat es between | |
2066 | if not IsB etweenMinA ndMax(DteT oChk) then | |
2067 | UseColor := clLtGr ay; | |
2068 | en d | |
2069 | el se if _min <> -1 the n | |
2070 | be gin | |
2071 | // All dat es between | |
2072 | if DateOf( DteToChk) < DateOf(F loatToDate Time(_min) ) then | |
2073 | UseColor := clLtGr ay; | |
2074 | en d | |
2075 | el se if _max <> -1 the n | |
2076 | be gin | |
2077 | // All dat es between | |
2078 | if DateOf( DteToChk) > DateOf(F loatToDate Time(_max) ) then | |
2079 | UseColor := clLtGr ay; | |
2080 | en d; | |
2081 | Br ush.Color := UseColo r; | |
2082 | end; | |
2083 | end; | |
2084 | Decode Date(Date, CurYear, CurMonth, CurDay); | |
2085 | if (Cu rYear = Ye ar) and (C urMonth = Month) and (IntToStr (CurDay) = TheText) | |
2086 | then | |
2087 | begin | |
2088 | TheT ext := '[' + TheText + ']'; | |
2089 | Font .Style := [fsBold]; | |
2090 | end; | |
2091 | ||
2092 | Font.C olor := In verseColor (Brush.Col or); | |
2093 | ||
2094 | TextRe ct(ARect, Left + (Ri ght - Left - TextWid th(TheText )) div 2, | |
2095 | Top + (Bottom - Top - Te xtHeight(T heText)) d iv 2, TheT ext); | |
2096 | end; | |
2097 | end; | |
2098 | ||
2099 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ---- Begin | |
2100 | ||
2101 | /// ////// ////////// ////////// ////////// ////////// ////////// ////////// ////////// / | |
2102 | constructo r TDateRan ge.Create; | |
2103 | begin | |
2104 | inherite d; | |
2105 | fMinDate := -1; | |
2106 | fMaxDate := -1; | |
2107 | end; | |
2108 | ||
2109 | procedure TDateRange .SetMinDat e(Const aM inDte: Dou ble); | |
2110 | begin | |
2111 | if (fMax Date <> -1 ) and (aMi nDte > fMa xDate) the n | |
2112 | begin | |
2113 | raise Exception. Create('Mi n date can not be aft er Max dat e'); | |
2114 | exit; | |
2115 | end; | |
2116 | fMinDate := aMinDt e; | |
2117 | end; | |
2118 | ||
2119 | procedure TDateRange .SetMaxDat e(const aM axDte: Dou ble); | |
2120 | begin | |
2121 | if (fMin Date <> -1 ) and (aMa xDte < fMi nDate) the n | |
2122 | begin | |
2123 | raise Exception. Create('Ma x date can not be bef ore Min da te'); | |
2124 | exit; | |
2125 | end; | |
2126 | fMaxDate := aMaxDt e; | |
2127 | end; | |
2128 | ||
2129 | function T DateRange. IsBetweenM inAndMax(c onst Looku pDate: TDa teTime): B oolean; | |
2130 | var | |
2131 | dd, ddd, dt: TDate Time; | |
2132 | begin | |
2133 | dt := Lo okupDate; | |
2134 | dd := fM inDate; | |
2135 | ddd := f MaxDate; | |
2136 | Result : = (dt >= d d) and (dt <= ddd); | |
2137 | // Resul t := (dt > = DateOf(f MinDate)) and (dt <= DateOf(fM axDate)); | |
2138 | end; | |
2139 | ||
2140 | function T DateRange. IsFullDay( const aDat e: TDateTi me): Boole an; | |
2141 | var | |
2142 | _min, _m ax, dtMin, dtMax: TD ateTime; | |
2143 | begin | |
2144 | _min := TDateTime( MinDate); | |
2145 | _max := TDateTime( MaxDate); | |
2146 | dtMin := round(aDa te) + 1 / (24 * 60 * 60); | |
2147 | dtMax := round(aDa te + 1) - 1 / (24 * 60 * 60); | |
2148 | Result : = (_min < dtMin) and (dtMax < _max); | |
2149 | end; | |
2150 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ------ End | |
2151 | ||
2152 | initializa tion | |
2153 | ||
2154 | uServerTod ay := 0; | |
2155 | FormatSett ings := TF ormatSetti ngs.Create ; | |
2156 | ||
2157 | end. |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.