Produced by Araxis Merge on 8/3/2017 10:10:43 AM Central Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
# | Location | File | Last Modified |
---|---|---|---|
1 | V31A.zip\V31A\434\OR_30_434V114_SRC\XE8\OR\Source | ORDtTm.pas | Wed Jun 14 19:03:20 2017 UTC |
2 | V31A.zip\V31A\434\OR_30_434V114_SRC\XE8\OR\Source | ORDtTm.pas | Thu Aug 3 13:29:06 2017 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 2 | 4370 |
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 | lblDat 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 | pnlPre vMonth: TP anel; | |
74 | pnlNex tMonth: TP anel; | |
75 | imgPre vMonth: TI mage; | |
76 | imgNex tMonth: TI mage; | |
77 | bvlRBu tton: TBev el; | |
78 | cmdTod ay: TButto n; | |
79 | cmdNow : TButton; | |
80 | cmdMid night: TBu tton; | |
81 | proced ure FormCr eate(Sende r: TObject ); | |
82 | proced ure calSel ectChange( Sender: TO bject); | |
83 | proced ure cmdTod ayClick(Se nder: TObj ect); | |
84 | proced ure txtTim eChange(Se nder: TObj ect); | |
85 | proced ure lstHou rClick(Sen der: TObje ct); | |
86 | proced ure lstMin uteClick(S ender: TOb ject); | |
87 | proced ure cmdNow Click(Send er: TObjec t); | |
88 | proced ure cmdOKC lick(Sende r: TObject ); | |
89 | proced ure cmdCan celClick(S ender: TOb ject); | |
90 | proced ure imgPre vMonthClic k(Sender: TObject); | |
91 | proced ure imgNex tMonthClic k(Sender: TObject); | |
92 | proced ure imgPre vMonthMous eDown(Send er: TObjec t; Button: TMouseBut ton; | |
93 | Shif t: TShiftS tate; X, Y : Integer) ; | |
94 | proced ure imgNex tMonthMous eDown(Send er: TObjec t; Button: TMouseBut ton; | |
95 | Shif t: TShiftS tate; X, Y : Integer) ; | |
96 | proced ure imgPre vMonthMous eUp(Sender : TObject; Button: T MouseButto n; | |
97 | Shif t: TShiftS tate; X, Y : Integer) ; | |
98 | proced ure imgNex tMonthMous eUp(Sender : TObject; Button: T MouseButto n; | |
99 | Shif t: TShiftS tate; X, Y : Integer) ; | |
100 | proced ure cmdMid nightClick (Sender: T Object); | |
101 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
102 | proced ure FormKe yDown(Send er: TObjec t; var Key : Word; Sh ift: TShif tState); | |
103 | proced ure lstHou rEnter(Sen der: TObje ct); | |
104 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
105 | private | |
106 | FFromS elf: Boole an; | |
107 | FNowPr essed: Boo lean; | |
108 | TimeIs Required: Boolean; | |
109 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
110 | proced ure setTim eListsBySe lectedDate ; | |
111 | proced ure setRan geTimeBoun daries; | |
112 | proced ure setBut tonStatus; | |
113 | functi on TimeIsV alid: Bool ean; | |
114 | functi on IsRange Mode: Bool ean; | |
115 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
116 | protecte d | |
117 | proced ure Loaded ; override ; | |
118 | end; | |
119 | ||
120 | { TORDat eTimeDlg } | |
121 | ||
122 | TORDateT imeDlg = c lass(TComp onent) | |
123 | private | |
124 | FDateT ime: TDate Time; | |
125 | FDateO nly: Boole an; | |
126 | FRequi reTime: Bo olean; | |
127 | FRelat iveTime: s tring; | |
128 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
129 | fDateR ange: TDat eRange; | |
130 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
131 | functi on GetFMDa teTime: TF MDateTime; | |
132 | proced ure SetDat eOnly(Valu e: Boolean ); | |
133 | proced ure SetFMD ateTime(Va lue: TFMDa teTime); | |
134 | proced ure SetReq uireTime(V alue: Bool ean); | |
135 | public | |
136 | constr uctor Crea te(AOwner: TComponen t); overri de; | |
137 | functi on Execute : Boolean; | |
138 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
139 | proper ty DateRan ge: TDateR ange read fDateRange write fDa teRange; | |
140 | proper ty DateTim e: TDateTi me read FD ateTime wr ite FDateT ime; | |
141 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
142 | proper ty Relativ eTime: str ing read F RelativeTi me; | |
143 | publishe d | |
144 | proper ty FMDateT ime: TFMDa teTime rea d GetFMDat eTime writ e SetFMDat eTime; | |
145 | proper ty DateOnl y: Boolean read FDat eOnly writ e SetDateO nly; | |
146 | proper ty Require Time: Bool ean read F RequireTim e write Se tRequireTi me; | |
147 | end; | |
148 | ||
149 | // 508 c lass | |
150 | TORDateB utton = cl ass(TBitBt n); | |
151 | ||
152 | { TORDat eBox } | |
153 | ||
154 | TORDateE dit = clas s(TEdit) | |
155 | protecte d | |
156 | proced ure Create Params(var Params: T CreatePara ms); overr ide; | |
157 | end; | |
158 | ||
159 | TORDateB ox = class (TORDateEd it, IVADyn amicProper ty, | |
160 | IORBla ckColorMod eCompatibl e) | |
161 | private | |
162 | FFMDat eTime: TFM DateTime; | |
163 | FDateO nly: Boole an; | |
164 | FRequi reTime: Bo olean; | |
165 | FButto n: TORDate Button; | |
166 | FForma t: string; | |
167 | FTimeI sNow: Bool ean; | |
168 | FTempl ateField: Boolean; | |
169 | FCapti on: TStati cText; | |
170 | FBlack ColorMode: Boolean; | |
171 | FOnDat eDialogClo sed: TNoti fyEvent; | |
172 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
173 | fDateS elected: T DateTime; | |
174 | fDateR ange: TDat eRange; | |
175 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
176 | proced ure Button Click(Send er: TObjec t); | |
177 | functi on GetFMDa teTime: TF MDateTime; | |
178 | functi on GetRela tiveTime: string; | |
179 | proced ure SetDat eOnly(Valu e: Boolean ); | |
180 | proced ure SetFMD ateTime(Va lue: TFMDa teTime); | |
181 | proced ure SetEdi tRect; | |
182 | proced ure SetReq uireTime(V alue: Bool ean); | |
183 | proced ure Update Text; | |
184 | proced ure WMSize (var Messa ge: TWMSiz e); messag e WM_SIZE; | |
185 | proced ure SetTem plateField (const Val ue: Boolea n); | |
186 | proced ure SetCap tion(const Value: st ring); | |
187 | functi on GetCapt ion(): str ing; | |
188 | protecte d | |
189 | proced ure Change ; override ; | |
190 | proced ure KeyPre ss(var Key : Char); o verride; | |
191 | proced ure KeyDow n(var Key: Word; Shi ft: TShift State); ov erride; | |
192 | proper ty DateBut ton: TORDa teButton r ead FButto n; | |
193 | proced ure SetEna bled(Value : Boolean) ; override ; | |
194 | // wat v28 when disabling TORDateBo x, button still appe ars active , this add resses tha t | |
195 | public | |
196 | constr uctor Crea te(AOwner: TComponen t); overri de; | |
197 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
198 | destru ctor Destr oy(); over ride; | |
199 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
200 | functi on IsValid : Boolean; | |
201 | proced ure Valida te(var Err Msg: strin g); | |
202 | proced ure SetBla ckColorMod e(Value: B oolean); | |
203 | functi on Support sDynamicPr operty(Pro pertyID: I nteger): B oolean; | |
204 | functi on GetDyna micPropert y(Property ID: Intege r): string ; | |
205 | proper ty Format: string re ad FFormat write FFo rmat; | |
206 | proper ty Relativ eTime: str ing read G etRelative Time; | |
207 | proper ty Templat eField: Bo olean read FTemplate Field writ e SetTempl ateField; | |
208 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
209 | proper ty DateSel ected: TDa teTime rea d fDateSel ected writ e fDateSel ected; | |
210 | proper ty DateRan ge: TDateR ange read fDateRange write fDa teRange; | |
211 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
212 | publishe d | |
213 | proper ty FMDateT ime: TFMDa teTime rea d GetFMDat eTime writ e SetFMDat eTime; | |
214 | proper ty DateOnl y: Boolean read FDat eOnly writ e SetDateO nly; | |
215 | proper ty Require Time: Bool ean read F RequireTim e write Se tRequireTi me; | |
216 | proper ty Caption : string r ead GetCap tion write SetCaptio n; | |
217 | proper ty OnDateD ialogClose d: TNotify Event read FOnDateDi alogClosed | |
218 | writ e FOnDateD ialogClose d; | |
219 | end; | |
220 | ||
221 | // 508 c lasses | |
222 | TORDayCo mbo = clas s(TORCombo Box); | |
223 | TORMonth Combo = cl ass(TORCom boBox); | |
224 | ||
225 | TORYearE dit = clas s(TMaskEdi t) | |
226 | private | |
227 | FTempl ateField: Boolean; | |
228 | proced ure SetTem plateField (const Val ue: Boolea n); | |
229 | protecte d | |
230 | proper ty Templat eField: Bo olean read FTemplate Field writ e SetTempl ateField; | |
231 | end; | |
232 | ||
233 | TORYearE ditClass = Class of TORYearEdi t; | |
234 | ||
235 | TORDateC ombo = cla ss(TCustom Panel, IOR BlackColor ModeCompat ible) | |
236 | private | |
237 | FYearC hanging: B oolean; | |
238 | FMonth Combo: TOR MonthCombo ; | |
239 | FDayCo mbo: TORDa yCombo; | |
240 | FYearE dit: TORYe arEdit; | |
241 | FYearU D: TUpDown ; | |
242 | FCalBt n: TORDate Button; | |
243 | FInclu deMonth: B oolean; | |
244 | FInclu deDay: Boo lean; | |
245 | FInclu deBtn: Boo lean; | |
246 | FLongM onths: Boo lean; | |
247 | FMonth : Integer; | |
248 | FDay: Integer; | |
249 | FYear: Integer; | |
250 | FCtrls Created: B oolean; | |
251 | FOnCha nge: TNoti fyEvent; | |
252 | FRebui lding: Boo lean; | |
253 | FTempl ateField: Boolean; | |
254 | FBlack ColorMode: Boolean; | |
255 | FORYea rEditClass : TORYearE ditClass; | |
256 | fColor : TColor; // NSR2007 1216 AA 20 16-01-22 | |
257 | proced ure SetCol or(const V alue: TCol or); // NS R20071216 AA 2016-01 -22 | |
258 | proced ure SetInc ludeBtn(co nst Value: Boolean); | |
259 | proced ure SetInc ludeDay(Va lue: Boole an); | |
260 | proced ure SetInc ludeMonth( const Valu e: Boolean ); | |
261 | proced ure SetLon gMonths(co nst Value: Boolean); | |
262 | proced ure SetDay (Value: In teger); | |
263 | proced ure SetMon th(Value: Integer); | |
264 | proced ure SetYea r(const Va lue: Integ er); | |
265 | functi on GetFMDa te: TFMDat eTime; | |
266 | proced ure SetFMD ate(const Value: TFM DateTime); | |
267 | proced ure CMFont Changed(va r Message: TMessage) ; message CM_FONTCHA NGED; | |
268 | proced ure SetTem plateField (const Val ue: Boolea n); | |
269 | protecte d | |
270 | proced ure Rebuil d; virtual ; | |
271 | functi on InitDay s(GetSize: Boolean): Integer; | |
272 | functi on InitMon ths(GetSiz e: Boolean ): Integer ; | |
273 | functi on GetYear Size: Inte ger; | |
274 | proced ure DoChan ge; | |
275 | proced ure MonthC hanged(Sen der: TObje ct); | |
276 | proced ure DayCha nged(Sende r: TObject ); | |
277 | proced ure YearCh anged(Send er: TObjec t); | |
278 | proced ure BtnCli cked(Sende r: TObject ); | |
279 | {XE8 r equires in teger, XE3 required SmallInt} | |
280 | proced ure YearUD Change(Sen der: TObje ct; var Al lowChange: Boolean; NewValue: Integer; D irection: TUpDownDir ection); | |
281 | proced ure YearKe yPress(Sen der: TObje ct; var Ke y: Char); | |
282 | proced ure CheckD ays; | |
283 | proced ure Loaded ; override ; | |
284 | proced ure Paint; override; | |
285 | proced ure Resize d(Sender: TObject); | |
286 | proper ty MonthCo mbo: TORMo nthCombo r ead FMonth Combo; | |
287 | proper ty DayComb o: TORDayC ombo read FDayCombo; | |
288 | proper ty YearEdi t: TORYear Edit read FYearEdit; | |
289 | proper ty YearUD: TUpDown r ead FYearU D; | |
290 | proper ty CalBtn: TORDateBu tton read FCalBtn; | |
291 | proper ty ORYearE ditClass: TORYearEdi tClass rea d FORYearE ditClass | |
292 | writ e FORYearE ditClass; | |
293 | public | |
294 | constr uctor Crea te(AOwner: TComponen t); overri de; | |
295 | destru ctor Destr oy; overri de; | |
296 | functi on DateTex t: string; | |
297 | proced ure SetBla ckColorMod e(Value: B oolean); | |
298 | proper ty Templat eField: Bo olean read FTemplate Field writ e SetTempl ateField; | |
299 | proper ty FMDate: TFMDateTi me read Ge tFMDate wr ite SetFMD ate; | |
300 | publishe d | |
301 | functi on Text: s tring; | |
302 | proper ty Include Btn: Boole an read FI ncludeBtn write SetI ncludeBtn; | |
303 | proper ty Include Day: Boole an read FI ncludeDay write SetI ncludeDay; | |
304 | proper ty Include Month: Boo lean read FIncludeMo nth write SetInclude Month; | |
305 | proper ty LongMon ths: Boole an read FL ongMonths write SetL ongMonths | |
306 | defa ult False; | |
307 | proper ty Month: Integer re ad FMonth write SetM onth; | |
308 | proper ty Day: In teger read FDay writ e SetDay; | |
309 | proper ty Year: I nteger rea d FYear wr ite SetYea r; | |
310 | proper ty OnChang e: TNotify Event read FOnChange write FOn Change; | |
311 | proper ty Color: TColor rea d fColor w rite SetCo lor; // NS R20071216 | |
312 | proper ty Anchors ; | |
313 | proper ty Enabled ; | |
314 | proper ty Font; | |
315 | proper ty ParentC olor; | |
316 | proper ty ParentF ont; | |
317 | proper ty TabOrde r; | |
318 | proper ty TabStop ; | |
319 | proper ty Visible ; | |
320 | end; | |
321 | ||
322 | function I sLeapYear( AYear: Int eger): Boo lean; | |
323 | function D aysPerMont h(AYear, A Month: Int eger): Int eger; | |
324 | function S erverFMNow : TFMDateT ime; | |
325 | function S erverParse FMDate(con st AString : string): TFMDateTi me; | |
326 | function S erverToday : TDateTim e; | |
327 | ||
328 | procedure Register; | |
329 | ||
330 | implementa tion | |
331 | ||
332 | uses | |
333 | System.U ITypes; | |
334 | ||
335 | {$R *.DFM} | |
336 | {$R ORDtTm } | |
337 | ||
338 | const | |
339 | FMT_DATE TIME = 'mm m d,yyyy@h h:nn'; | |
340 | FMT_DATE ONLY = 'mm m d,yyyy'; | |
341 | AdjVertS ize = 8; | |
342 | FontHeig htText = ' BEFHILMSTV WXZfgjmpqt yk'; | |
343 | ||
344 | var | |
345 | uServerT oday: TFMD ateTime; | |
346 | FormatSe ttings: TF ormatSetti ngs; | |
347 | ||
348 | { Server -dependent functions --------- ---------- ---------- ---------- ---------- ---------- ----- } | |
349 | ||
350 | function A ctiveBroke r: Boolean ; | |
351 | begin | |
352 | Result : = False; | |
353 | if (RPCB rokerV <> nil) and R PCBrokerV. Connected then | |
354 | Result := True; | |
355 | end; | |
356 | ||
357 | function S erverFMNow : TFMDateT ime; | |
358 | var | |
359 | aStr: st ring; | |
360 | begin | |
361 | if Activ eBroker th en | |
362 | begin | |
363 | Call VistA('ORW U DT', ['N OW'], aStr ); | |
364 | Resu lt := StrT oFloat(aSt r); | |
365 | end | |
366 | else | |
367 | Result := DateTi meToFMDate Time(Now); | |
368 | end; | |
369 | ||
370 | function S erverNow: TDateTime; | |
371 | begin | |
372 | if Activ eBroker th en | |
373 | Result := FMDate TimeToDate Time(Serve rFMNow) | |
374 | else | |
375 | Result := Now; | |
376 | end; | |
377 | ||
378 | function S erverToday : TDateTim e; | |
379 | begin | |
380 | if uServ erToday = 0 then | |
381 | uServe rToday := Int(Server FMNow); | |
382 | Result : = FMDateTi meToDateTi me(uServer Today); | |
383 | end; | |
384 | ||
385 | function S erverParse FMDate(con st AString : string): TFMDateTi me; | |
386 | var | |
387 | aStr: st ring; | |
388 | begin | |
389 | if Activ eBroker th en | |
390 | begin | |
391 | Call VistA('ORW U DT', [AS tring, 'TS X'], aStr) ; | |
392 | Resu lt := StrT oFloat(aSt r); | |
393 | end | |
394 | else Res ult := 0; | |
395 | end; | |
396 | ||
397 | function R elativeDat eTime(ADat eTime: TDa teTime): s tring; | |
398 | var | |
399 | Offset: Integer; | |
400 | h, n, s, l: Word; | |
401 | ATime: s tring; | |
402 | begin | |
403 | Offset : = Trunc(In t(aDateTim e) - Int(S erverToday )); | |
404 | if Offse t < 0 then | |
405 | Result := 'T' + IntToStr(O ffset) | |
406 | else if Offset = 0 then | |
407 | Result := 'T' | |
408 | else | |
409 | Result := 'T+' + IntToStr( Offset); | |
410 | DecodeTi me(aDateTi me, h, n, s, l); | |
411 | ATime := Format('@ %.2d:%.2d' , [h, n]); | |
412 | if ATime <> '@00:0 0' then | |
413 | Result := Result + ATime; | |
414 | end; | |
415 | ||
416 | procedure LoadEllips is(bitmap: TBitMap; BlackColor Mode: Bool ean); | |
417 | var | |
418 | ResName: string; | |
419 | begin | |
420 | if Black ColorMode then | |
421 | ResNam e := 'BLAC K_BMP_ELLI PSIS' | |
422 | else | |
423 | ResNam e := 'BMP_ ELLIPSIS'; | |
424 | bitmap.L oadFromRes ourceName( hInstance, ResName); | |
425 | end; | |
426 | ||
427 | /// ////// ////////// ////////// ////////// ////////// ////////// ////////// ////////// / | |
428 | function s tripCharSe t(AString: String; a Set: TSysC harSet): S tring; | |
429 | var | |
430 | i: Integ er; | |
431 | begin | |
432 | Result : = AString; | |
433 | for i := Length(Re sult) down to 1 do | |
434 | if not CharInSet (Result[i] , aSet) th en | |
435 | Dele te(Result, i, 1); | |
436 | end; | |
437 | ||
438 | function s tripChars( AString: S tring): St ring; | |
439 | begin | |
440 | Result : = stripCha rSet(AStri ng, ['0' . . '9']); | |
441 | end; | |
442 | ||
443 | { TfrmORDt Tm ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- --- } | |
444 | ||
445 | procedure TORfrmDtTm .FormCreat e(Sender: TObject); | |
446 | begin | |
447 | ResizeAn choredForm ToFont(sel f); | |
448 | lstHour. TopIndex : = 6; | |
449 | FFromSel f := False ; | |
450 | if Scree nReaderSys temActive then | |
451 | GetScr eenReader. Speak(Labe l1.Caption ); | |
452 | end; | |
453 | ||
454 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ---- Begin | |
455 | procedure TORfrmDtTm .FormKeyDo wn(Sender: TObject; var Key: W ord; | |
456 | Shift: T ShiftState ); | |
457 | begin | |
458 | if Key = VK_ESCAPE then | |
459 | ModalR esult := m rCancel; | |
460 | end; | |
461 | ||
462 | procedure TORfrmDtTm .setTimeLi stsBySelec tedDate; | |
463 | begin | |
464 | lstHour. MinTime := -1; | |
465 | lstHour. MaxTime := -1; | |
466 | lstMinut e.MinTime := -1; | |
467 | lstMinut e.MaxTime := -1; | |
468 | // Check for Min a nd Max of calendar | |
469 | if DateO f(calSelec t.Calendar Date) <= D ateOf(calS elect.MinD ateTime) t hen | |
470 | begin | |
471 | lstHou r.MinTime := HourOf( calSelect. MinDateTim e); | |
472 | lstMin ute.MinTim e := Minut eOf(calSel ect.MinDat eTime); | |
473 | if Tim eOf(calSel ect.Calend arDate) < calSelect. MinDateTim e then | |
474 | begin | |
475 | lstH our.ItemIn dex := Hou rOf(calSel ect.MinDat eTime); | |
476 | lstM inute.Item Index := M inuteOf(ca lSelect.Mi nDateTime) div 5; | |
477 | end; | |
478 | end | |
479 | else if DateOf(cal Select.Cal endarDate) >= DateOf (calSelect .MaxDateTi me) then | |
480 | begin | |
481 | lstHou r.MaxTime := HourOf( calSelect. MaxDateTim e); | |
482 | lstMin ute.MaxTim e := Minut eOf(calSel ect.MaxDat eTime); | |
483 | if Tim eOf(calSel ect.Calend arDate) > calSelect. MaxDateTim e then | |
484 | begin | |
485 | lstH our.ItemIn dex := Hou rOf(calSel ect.MaxDat eTime); | |
486 | lstM inute.Item Index := M inuteOf(ca lSelect.Mi nDateTime) div 5; | |
487 | end; | |
488 | end | |
489 | else // Date withi n range | |
490 | begin | |
491 | lstHou r.ItemInde x := 6; | |
492 | lstMin ute.ItemIn dex := 0; | |
493 | end; | |
494 | lstHour. Repaint; | |
495 | lstMinut e.Repaint; | |
496 | end; | |
497 | ||
498 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ------ End | |
499 | function T ORfrmDtTm. IsRangeMod e: Boolean ; | |
500 | begin | |
501 | // fix for Defect #3 32950: | |
502 | // Access violation in TORDate Combo comp onent on s electing t he date in the assoc iated Cale ndar form | |
503 | Result : = calSelec t.isRangeM ode; | |
504 | end; | |
505 | ||
506 | procedure TORfrmDtTm .calSelect Change(Sen der: TObje ct); | |
507 | begin | |
508 | lblDate. Caption := FormatDat eTime('mmm m d, yyyy' , calSelec t.Calendar Date); | |
509 | FNowPres sed := Fal se; | |
510 | if Scree nReaderSys temActive then | |
511 | begin | |
512 | // Txt DateSelect ed.Caption := lblDat e.Caption; | |
513 | TxtDat eSelected. Caption := Label1.Ca ption + ' ' + lblDat e.Caption; | |
514 | GetScr eenReader. Speak(lblD ate.Captio n); | |
515 | end; | |
516 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- ------ Beg in | |
517 | if IsRan geMode the n // check if the va lid range was set | |
518 | begin | |
519 | // Now need to e nforce inv alid times | |
520 | setTim eListsBySe lectedDate ; | |
521 | if Tim eIsRequire d then | |
522 | lstM inuteClick (nil); | |
523 | setBut tonStatus; | |
524 | end; | |
525 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- -------- E nd | |
526 | end; | |
527 | ||
528 | procedure TORfrmDtTm .imgPrevMo nthMouseDo wn(Sender: TObject; | |
529 | Button: TMouseButt on; Shift: TShiftSta te; X, Y: Integer); | |
530 | begin | |
531 | pnlPrevM onth.Bevel Outer := b vLowered; | |
532 | end; | |
533 | ||
534 | procedure TORfrmDtTm .imgNextMo nthMouseDo wn(Sender: TObject; | |
535 | Button: TMouseButt on; Shift: TShiftSta te; X, Y: Integer); | |
536 | begin | |
537 | pnlNextM onth.Bevel Outer := b vLowered; | |
538 | end; | |
539 | ||
540 | procedure TORfrmDtTm .imgPrevMo nthClick(S ender: TOb ject); | |
541 | begin | |
542 | calSelec t.PrevMont h; | |
543 | end; | |
544 | ||
545 | procedure TORfrmDtTm .imgNextMo nthClick(S ender: TOb ject); | |
546 | begin | |
547 | calSelec t.NextMont h; | |
548 | end; | |
549 | ||
550 | procedure TORfrmDtTm .imgPrevMo nthMouseUp (Sender: T Object; Bu tton: TMou seButton; | |
551 | Shift: T ShiftState ; X, Y: In teger); | |
552 | begin | |
553 | pnlPrevM onth.Bevel Outer := b vRaised; | |
554 | end; | |
555 | ||
556 | procedure TORfrmDtTm .imgNextMo nthMouseUp (Sender: T Object; Bu tton: TMou seButton; | |
557 | Shift: T ShiftState ; X, Y: In teger); | |
558 | begin | |
559 | pnlNextM onth.Bevel Outer := b vRaised; | |
560 | end; | |
561 | ||
562 | procedure TORfrmDtTm .cmdTodayC lick(Sende r: TObject ); | |
563 | begin | |
564 | calSelec t.Calendar Date := Se rverToday; | |
565 | ||
566 | // cmdTo day is dis abled if o ut of assi gned valid range | |
567 | if not I sRangeMode then | |
568 | begin | |
569 | lstHou r.ItemInde x := -1; | |
570 | lstMin ute.ItemIn dex := -1; | |
571 | txtTim e.Text := ''; | |
572 | end; | |
573 | end; | |
574 | ||
575 | procedure TORfrmDtTm .txtTimeCh ange(Sende r: TObject ); | |
576 | begin | |
577 | if not F FromSelf t hen | |
578 | begin | |
579 | lstHou r.ItemInde x := -1; | |
580 | lstMin ute.ItemIn dex := -1; | |
581 | end; | |
582 | FNowPres sed := Fal se; | |
583 | end; | |
584 | ||
585 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ---- Begin | |
586 | procedure TORfrmDtTm .setButton Status; | |
587 | var | |
588 | dt: TDat eTime; | |
589 | begin | |
590 | if IsRan geMode the n | |
591 | begin | |
592 | cmdNow .Enabled : = calSelec t.ValidRan ge.IsBetwe enMinAndMa x(Now); | |
593 | cmdTod ay.Enabled := calSel ect.ValidR ange.IsBet weenMinAnd Max(Server Today); | |
594 | dt := calSelect. CalendarDa te; | |
595 | cmdMid night.Enab led := cal Select.Val idRange.Is BetweenMin AndMax | |
596 | (rou nd(dt) + 1 - 1 / (24 * 60)); | |
597 | end; | |
598 | end; | |
599 | ||
600 | procedure TORfrmDtTm .setRangeT imeBoundar ies; | |
601 | var | |
602 | HourSel: String; | |
603 | begin | |
604 | // only in case th e valid ra nge is ass igned | |
605 | if (not assigned(c alSelect.V alidRange) ) or ( | |
606 | (calSele ct.ValidRa nge.MaxDat e = -1) an d (calSele ct.ValidRa nge.MinDat e = -1) | |
607 | ) | |
608 | then | |
609 | exit; | |
610 | ||
611 | // Need to set the min minut e | |
612 | lstMinut e.MinTime := -1; | |
613 | lstMinut e.MaxTime := -1; | |
614 | ||
615 | // Grab the hour s elected | |
616 | if lstHo ur.ItemInd ex < 0 the n | |
617 | HourSe l := '0' | |
618 | else | |
619 | HourSe l := strip Chars(lstH our.Items[ lstHour.It emIndex]); | |
620 | ||
621 | // Now n eed to enf orce inval id times | |
622 | if DateO f(calSelec t.Calendar Date) = Da teOf(calSe lect.MinDa teTime) th en | |
623 | begin // date is o n the rang e boundary | |
624 | if Str ToIntDef(H ourSel, -1 ) <= HourO f(calSelec t.MinDateT ime) then | |
625 | begin // reset m inutes of the bounda ry hour | |
626 | lstH our.ItemIn dex := Hou rOf(calSel ect.MinDat eTime); | |
627 | ||
628 | lstM inute.MinT ime := Min uteOf(calS elect.MinD ateTime); | |
629 | // c alculate m in index | |
630 | if ( lstMinute. ItemIndex = -1) // m inutes wer e not sele cted | |
631 | or (lstMinut e.ItemInde x < Minute Of(calSele ct.MinDate Time)) the n | |
632 | // assign mi n index if mot assig ned | |
633 | ls tMinute.It emIndex := MinuteOf( calSelect. MinDateTim e) | |
634 | end | |
635 | else | |
636 | // r eset minut es | |
637 | lstM inute.Item Index := 0 ; // -1; | |
638 | end | |
639 | else if DateOf(cal Select.Cal endarDate) = DateOf( calSelect. MaxDateTim e) then | |
640 | begin // date is o n the rang e boundary | |
641 | if Str ToIntDef(H ourSel, -1 ) >= HourO f(calSelec t.MaxDateT ime) then | |
642 | begin | |
643 | lstH our.ItemIn dex := Hou rOf(calSel ect.MaxDat eTime); | |
644 | ||
645 | lstM inute.MaxT ime := Min uteOf(calS elect.MaxD ateTime); | |
646 | // c alculate m in index | |
647 | if ( lstMinute. ItemIndex = -1) or | |
648 | (l stMinute.I temIndex > MinuteOf( calSelect. MinDateTim e)) then | |
649 | // assign mi n index if mot assig ned | |
650 | ls tMinute.Ma xTime := M inuteOf(ca lSelect.Ma xDateTime) ; | |
651 | end | |
652 | else | |
653 | // r eset minut es | |
654 | lstM inute.Item Index := 0 ; // was - 1; | |
655 | end; | |
656 | lstMinut e.Repaint; | |
657 | end; | |
658 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ------ End | |
659 | ||
660 | procedure TORfrmDtTm .lstHourCl ick(Sender : TObject) ; | |
661 | begin | |
662 | setRange TimeBounda ries; // N SR20071216 AA 2016-0 1-29 | |
663 | ||
664 | if lstHo ur.ItemInd ex = 0 the n | |
665 | lstMin ute.Items[ 0] := ':01 --' | |
666 | else | |
667 | lstMin ute.Items[ 0] := ':00 --'; // <------ NE W CODE | |
668 | lstMinut eClick(sel f); | |
669 | end; | |
670 | ||
671 | procedure TORfrmDtTm .lstHourEn ter(Sender : TObject) ; | |
672 | begin | |
673 | setRange TimeBounda ries; // N SR20071216 AA 2016-0 1-29 | |
674 | end; | |
675 | ||
676 | procedure TORfrmDtTm .lstMinute Click(Send er: TObjec t); | |
677 | var | |
678 | AnHour, AMinute: I nteger; | |
679 | begin | |
680 | if lstHo ur.ItemInd ex >= 0 th en | |
681 | begin | |
682 | AnHour := lstHou r.ItemInde x; | |
683 | if lst Minute.Ite mIndex >= 0 then | |
684 | AMin ute := lst Minute.Ite mIndex * 5 | |
685 | else | |
686 | AMin ute := 0; // NSR2007 1216 AA 20 16-01-29 | |
687 | if (An Hour = 0) and (AMinu te = 0) th en | |
688 | AMin ute := 1; // <------ -------- N EW CODE | |
689 | FFromS elf := Tru e; | |
690 | txtTim e.Text := Format('%. 2d:%.2d ', [AnHour, AMinute]); | |
691 | ||
692 | FFromS elf := Fal se; | |
693 | end; | |
694 | end; | |
695 | ||
696 | procedure TORfrmDtTm .cmdNowCli ck(Sender: TObject); | |
697 | begin | |
698 | calSelec t.Calendar Date := Se rverToday; | |
699 | txtTime. Text := Fo rmatDateTi me('hh:nn' , ServerNo w); // if ampm time | |
700 | ||
701 | lstHou r.ItemInde x := -1; | |
702 | lstMin ute.ItemIn dex := -1; | |
703 | ||
704 | FNowPres sed := Tru e; | |
705 | end; | |
706 | ||
707 | procedure TORfrmDtTm .cmdMidnig htClick(Se nder: TObj ect); | |
708 | begin | |
709 | txtTime. Text := '2 3:59'; // if militar y time | |
710 | ||
711 | lstHour. ItemIndex := -1; | |
712 | lstMinut e.ItemInde x := -1; | |
713 | end; | |
714 | ||
715 | function T ORfrmDtTm. TimeIsVali d: Boolean ; | |
716 | var | |
717 | dt: TDat eTime; | |
718 | tm: TDat eTime; | |
719 | const | |
720 | fmtOutOf Range = 'T ime entere d %s is ou tside of t he allowed range.' + CRLF + | |
721 | 'Pleas e enter a valid time .'; | |
722 | ||
723 | procedur e ReportEr ror(aSelec tion: Stri ng); | |
724 | begin | |
725 | InfoBo x(Format(f mtOutOfRan ge, [aSele ction]) | |
726 | {$IFDEF DE BUG} | |
727 | + CRLF + CRLF | |
728 | + 'Min date:time ' + Forma tDateTime( 'mm:dd:yyy y hh:nn',c alSelect.f ValidRange .MinDate) + CRLF | |
729 | + 'Max date:time ' + Forma tDateTime( 'mm:dd:yyy y hh:nn',c alSelect.f ValidRange .MaxDate) + CRLF | |
730 | {$ENDIF} | |
731 | , 'Inv alid Time' , MB_OK); | |
732 | end; | |
733 | ||
734 | begin | |
735 | if not T imeIsRequi red then | |
736 | Result := True | |
737 | else | |
738 | begin | |
739 | Resu lt := Fals e; | |
740 | if L ength(txtT ime.Text) > 0 then | |
741 | begi n | |
742 | tr y | |
743 | tm := strT oTime(txtT ime.Text); | |
744 | if IsRange Mode then | |
745 | begin | |
746 | dt := calSelect. CalendarDa te; | |
747 | dt := trunc(dt) + tm; | |
748 | if not calSelect .IsBetween MinAndMax( dt) then | |
749 | {$IF DEF DEBUG} | |
750 | Repo rtError(fo rmatDateTi me('dd-mm- yyyy hh:nn ',dt)) | |
751 | {$EL SE} | |
752 | Repo rtError(tx tTime.Text ) | |
753 | {$EN DIF} | |
754 | else | |
755 | Resu lt := True ; | |
756 | end | |
757 | else | |
758 | Result : = True; | |
759 | ex cept | |
760 | on EConver tError do | |
761 | ReportEr ror('Inval id Time st ring' + CR LF + 'Plea se enter a valid tim e'); | |
762 | en d; | |
763 | end | |
764 | else | |
765 | Re portError( 'Please en ter a vali d time'); | |
766 | end; | |
767 | end; | |
768 | ||
769 | procedure TORfrmDtTm .cmdOKClic k(Sender: TObject); | |
770 | var | |
771 | X: strin g; | |
772 | ||
773 | begin | |
774 | if not T imeIsRequi red then | |
775 | begin | |
776 | Moda lResult := mrOK; | |
777 | exit ; | |
778 | end; | |
779 | ||
780 | if TimeI sRequired and (Lengt h(txtTime. Text) = 0) then | |
781 | begin | |
782 | InfoBo x('An entr y for time is requir ed.', 'Mis sing Time' , MB_OK); | |
783 | exit; | |
784 | end; | |
785 | ||
786 | if Lengt h(txtTime. Text) > 0 then | |
787 | begin | |
788 | X := T rim(txtTim e.Text); | |
789 | if (X = '00:00') or (X = ' 0:00') or (X = '00:0 0:00') or (X = '0:00 :00') then | |
790 | X := '00:01'; // <------ - CHANGED CODE | |
791 | try | |
792 | StrT oTime(X); | |
793 | txtT ime.Text : = X; | |
794 | if T imeIsValid then // N SR20071216 AA 2016-0 1-29 | |
795 | Mo dalResult := mrOK; | |
796 | except | |
797 | on E ConvertErr or do | |
798 | In foBox('Inc orrect tim e value "' +X+'"', 'I nvalid Tim e value', MB_OK); | |
799 | end; | |
800 | end; | |
801 | end; | |
802 | ||
803 | procedure TORfrmDtTm .cmdCancel Click(Send er: TObjec t); | |
804 | begin | |
805 | ModalRes ult := mrC ancel; | |
806 | end; | |
807 | ||
808 | procedure TORfrmDtTm .Loaded; | |
809 | begin | |
810 | inherite d Loaded; | |
811 | UpdateCo lorsFor508 Compliance (self); | |
812 | end; | |
813 | ||
814 | { TORDateT imeDlg } | |
815 | ||
816 | constructo r TORDateT imeDlg.Cre ate(AOwner : TCompone nt); | |
817 | begin | |
818 | inherite d Create(A Owner); | |
819 | if not(c sDesigning in Compon entState) then | |
820 | FDateT ime := Ser verToday | |
821 | else | |
822 | FDateT ime := Sys Utils.Date ; | |
823 | end; | |
824 | ||
825 | function T ORDateTime Dlg.Execut e: Boolean ; | |
826 | const | |
827 | HORZ_SPA CING = 8; | |
828 | var | |
829 | frmDtTm: TORfrmDtT m; | |
830 | ||
831 | // NSR20 071216 AA 2016-01-29 --------- ---------- ---------- ---------- ------ Beg in | |
832 | procedur e setRange ; | |
833 | begin | |
834 | with f rmDtTm do | |
835 | begin | |
836 | if A ssigned(se lf.DateRan ge) then | |
837 | begi n | |
838 | if (self.Dat eRange.Min Date <> -1 ) or (self .DateRange .MaxDate < > -1) then | |
839 | Caption := Caption + ' between ' + Forma tDateTime( 'mmm dd,YY @hh:nn ', | |
840 | self.Dat eRange.Min Date) + ' and ' + | |
841 | FormatDa teTime('mm m dd,YY@hh :nn', self .DateRange .MaxDate); | |
842 | ca lSelect.Va lidRange : = self.Dat eRange; | |
843 | ca lSelect.Ca lendarDate := self.D ateTime; | |
844 | se tButtonSta tus; | |
845 | end; | |
846 | end; | |
847 | end; | |
848 | // NSR2007 1216 AA 20 16-01-29 - ---------- ---------- ---------- ---------- ------ End | |
849 | ||
850 | begin | |
851 | frmDtTm := TORfrmD tTm.Create (Applicati on); | |
852 | try | |
853 | with f rmDtTm do | |
854 | begin | |
855 | lblD ate.Captio n := Forma tDateTime( 'mmmm d, y yyy',FDate Time); | |
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 isR angeMode a nd (Calend arDate < M inDateTime ) 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 isR angeMode a nd (Calend arDate < M inDateTime ) 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 isR angeMode a nd (Calend arDate > M axDateTime ) 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 isR angeMode a nd (Calend arDate > M axDateTime ) 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 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- ------ Beg in | |
2000 | if Assig ned(ValidR ange) then | |
2001 | Result := ValidR ange.IsBet weenMinAnd Max(Lookup Date) | |
2002 | else | |
2003 | Result := True; | |
2004 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- -------- E nd | |
2005 | end; | |
2006 | ||
2007 | function T ORCalendar .isRangeMo de: boolea n; | |
2008 | begin | |
2009 | // fix for Defect #3 32950: | |
2010 | // Access violation in TORDate Combo comp onent on s electing t he date in the assoc iated Cale ndar form | |
2011 | Result : = Assigned (ValidRang e) and ( | |
2012 | (Valid Range.MaxD ate <> -1) or (Valid Range.MinD ate <> -1) | |
2013 | ); | |
2014 | end; | |
2015 | ||
2016 | function T ORCalendar .SelectCel l(ACol, AR ow: Longin t): Boolea n; | |
2017 | var | |
2018 | TheText: string; | |
2019 | DteToChk : TDateTim e; | |
2020 | _min, _m ax: TDateT ime; | |
2021 | begin | |
2022 | Result : = (Inherit ed); | |
2023 | ||
2024 | TheText := CellTex t[ACol, AR ow]; | |
2025 | if TheTe xt = '' th en | |
2026 | exit; | |
2027 | DteToChk := Encode Date(Year, Month, St rToIntDef( TheText, 0 )); | |
2028 | ||
2029 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- ------ Beg in | |
2030 | if Assig ned(ValidR ange) then | |
2031 | begin | |
2032 | if Res ult then | |
2033 | begin | |
2034 | _min := getMin DateTime; | |
2035 | _max := getMax DateTime; | |
2036 | if _ min <> -1 then | |
2037 | Re sult := Da teOf(DteTo Chk) >= Da teOf(Float ToDateTime (_min)); | |
2038 | if _ max <> -1 then | |
2039 | Re sult := Re sult and | |
2040 | (DateOf(Dt eToChk) <= DateOf(Fl oatToDateT ime(_max)) ); | |
2041 | end; | |
2042 | end; | |
2043 | // NSR20 071216 AA 2016-01-22 --------- ---------- ---------- ---------- -------- E nd | |
2044 | end; | |
2045 | ||
2046 | function I nverseColo r(Color: T Color): TC olor; | |
2047 | var | |
2048 | rgb_: TC olorref; | |
2049 | ||
2050 | function Inv(b: By te): Byte; | |
2051 | begin | |
2052 | if b > 128 then | |
2053 | Resu lt := 0 | |
2054 | else | |
2055 | Resu lt := 255; | |
2056 | end; | |
2057 | ||
2058 | begin | |
2059 | rgb_ := ColorToRgb (Color); | |
2060 | rgb_ := RGB(Inv(Ge tRValue(rg b_)), Inv( GetGValue( rgb_)), In v(GetBValu e(rgb_))); | |
2061 | ||
2062 | Result : = rgb_; | |
2063 | end; | |
2064 | ||
2065 | procedure TORCalenda r.DrawCell (ACol, ARo w: Longint ; ARect: T Rect; | |
2066 | AState: TGridDrawS tate); | |
2067 | var | |
2068 | TheText: string; | |
2069 | DteToChk : TDateTim e; | |
2070 | CurMonth , CurYear, CurDay: W ord; | |
2071 | UseColor : TColor; | |
2072 | _min, _m ax: TDateT ime; | |
2073 | ||
2074 | begin | |
2075 | TheText := CellTex t[ACol, AR ow]; | |
2076 | with ARe ct, Canvas do | |
2077 | begin | |
2078 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- -------- B egin | |
2079 | if Ass igned(Vali dRange) th en | |
2080 | // NSR 20071216 A A 2016-01- 22 ------- ---------- ---------- ---------- ---------- End | |
2081 | begin | |
2082 | _min := getMin DateTime; | |
2083 | _max := getMax DateTime; | |
2084 | ||
2085 | if S trToIntDef (TheText, -1) <> -1 then | |
2086 | begi n | |
2087 | Dt eToChk := EncodeDate (Year, Mon th, StrToI ntDef(TheT ext, 0)); | |
2088 | Us eColor := clWindow; | |
2089 | // if IsFull Day(DteToC hk) then | |
2090 | // UseColor := clLtGra y; | |
2091 | ||
2092 | if (_min <> -1) and (_ max <> -1) then | |
2093 | be gin | |
2094 | // All dat es between | |
2095 | if not IsB etweenMinA ndMax(DteT oChk) then | |
2096 | UseColor := clLtGr ay; | |
2097 | en d | |
2098 | el se if _min <> -1 the n | |
2099 | be gin | |
2100 | // All dat es between | |
2101 | if DateOf( DteToChk) < DateOf(F loatToDate Time(_min) ) then | |
2102 | UseColor := clLtGr ay; | |
2103 | en d | |
2104 | el se if _max <> -1 the n | |
2105 | be gin | |
2106 | // All dat es between | |
2107 | if DateOf( DteToChk) > DateOf(F loatToDate Time(_max) ) then | |
2108 | UseColor := clLtGr ay; | |
2109 | en d; | |
2110 | Br ush.Color := UseColo r; | |
2111 | end; | |
2112 | end; | |
2113 | Decode Date(Date, CurYear, CurMonth, CurDay); | |
2114 | if (Cu rYear = Ye ar) and (C urMonth = Month) and (IntToStr (CurDay) = TheText) | |
2115 | then | |
2116 | begin | |
2117 | TheT ext := '[' + TheText + ']'; | |
2118 | Font .Style := [fsBold]; | |
2119 | end; | |
2120 | ||
2121 | Font.C olor := In verseColor (Brush.Col or); | |
2122 | ||
2123 | TextRe ct(ARect, Left + (Ri ght - Left - TextWid th(TheText )) div 2, | |
2124 | Top + (Bottom - Top - Te xtHeight(T heText)) d iv 2, TheT ext); | |
2125 | end; | |
2126 | end; | |
2127 | ||
2128 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ---- Begin | |
2129 | ||
2130 | /// ////// ////////// ////////// ////////// ////////// ////////// ////////// ////////// / | |
2131 | constructo r TDateRan ge.Create; | |
2132 | begin | |
2133 | inherite d; | |
2134 | fMinDate := -1; | |
2135 | fMaxDate := -1; | |
2136 | end; | |
2137 | ||
2138 | procedure TDateRange .SetMinDat e(Const aM inDte: Dou ble); | |
2139 | begin | |
2140 | if (fMax Date <> -1 ) and (aMi nDte > fMa xDate) the n | |
2141 | begin | |
2142 | raise Exception. Create('Mi n date can not be aft er Max dat e'); | |
2143 | exit; | |
2144 | end; | |
2145 | fMinDate := aMinDt e; | |
2146 | end; | |
2147 | ||
2148 | procedure TDateRange .SetMaxDat e(const aM axDte: Dou ble); | |
2149 | begin | |
2150 | if (fMin Date <> -1 ) and (aMa xDte < fMi nDate) the n | |
2151 | begin | |
2152 | raise Exception. Create('Ma x date can not be bef ore Min da te'); | |
2153 | exit; | |
2154 | end; | |
2155 | fMaxDate := aMaxDt e; | |
2156 | end; | |
2157 | ||
2158 | function T DateRange. IsBetweenM inAndMax(c onst Looku pDate: TDa teTime): B oolean; | |
2159 | var | |
2160 | dd, ddd, dt: TDate Time; | |
2161 | begin | |
2162 | dt := Lo okupDate; | |
2163 | dd := fM inDate; | |
2164 | ddd := f MaxDate; | |
2165 | Result : = (dt >= d d) and (dt <= ddd); | |
2166 | // Resul t := (dt > = DateOf(f MinDate)) and (dt <= DateOf(fM axDate)); | |
2167 | end; | |
2168 | ||
2169 | function T DateRange. IsFullDay( const aDat e: TDateTi me): Boole an; | |
2170 | var | |
2171 | _min, _m ax, dtMin, dtMax: TD ateTime; | |
2172 | begin | |
2173 | _min := TDateTime( MinDate); | |
2174 | _max := TDateTime( MaxDate); | |
2175 | dtMin := round(aDa te) + 1 / (24 * 60 * 60); | |
2176 | dtMax := round(aDa te + 1) - 1 / (24 * 60 * 60); | |
2177 | Result : = (_min < dtMin) and (dtMax < _max); | |
2178 | end; | |
2179 | // NSR2007 1216 AA 20 16-01-22 - ---------- ---------- ---------- ---------- ------ End | |
2180 | ||
2181 | initializa tion | |
2182 | ||
2183 | uServerTod ay := 0; | |
2184 | FormatSett ings := TF ormatSetti ngs.Create ; | |
2185 | ||
2186 | end. |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.