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