Produced by Araxis Merge on 8/3/2017 10:10:45 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\448\OR_30_448V7_SRC\OR | ORDtTm.pas | Thu Mar 2 16:33:28 2017 UTC |
2 | V31A.zip\V31A\448\OR_30_448V7_SRC\OR | ORDtTm.pas | Thu Aug 3 13:30:09 2017 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 2 | 2930 |
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, StdC trls, Butt ons, | |
9 | Grids, C alendar, E xtCtrls, O RFn, ORNet , ORDtTmCa l, Mask, C omCtrls, O R2006Compa tibility, | |
10 | ORCtrls, VAClasses ; | |
11 | ||
12 | type | |
13 | TORfrmDt Tm = class (Tfrm2006C ompatibili ty) | |
14 | bvlFra me: TBevel ; | |
15 | lblDat e: TPanel; | |
16 | txtTim e: TEdit; | |
17 | lstHou r: TListBo x; | |
18 | lstMin ute: TList Box; | |
19 | cmdOK: TButton; | |
20 | cmdCan cel: TButt on; | |
21 | calSel ect: TORCa lendar; | |
22 | pnlPre vMonth: TP anel; | |
23 | pnlNex tMonth: TP anel; | |
24 | imgPre vMonth: TI mage; | |
25 | imgNex tMonth: TI mage; | |
26 | bvlRBu tton: TBev el; | |
27 | cmdTod ay: TButto n; | |
28 | cmdNow : TButton; | |
29 | cmdMid night: TBu tton; | |
30 | proced ure FormCr eate(Sende r: TObject ); | |
31 | proced ure calSel ectChange( Sender: TO bject); | |
32 | proced ure cmdTod ayClick(Se nder: TObj ect); | |
33 | proced ure txtTim eChange(Se nder: TObj ect); | |
34 | proced ure lstHou rClick(Sen der: TObje ct); | |
35 | proced ure lstMin uteClick(S ender: TOb ject); | |
36 | proced ure cmdNow Click(Send er: TObjec t); | |
37 | proced ure cmdOKC lick(Sende r: TObject ); | |
38 | proced ure cmdCan celClick(S ender: TOb ject); | |
39 | proced ure imgPre vMonthClic k(Sender: TObject); | |
40 | proced ure imgNex tMonthClic k(Sender: TObject); | |
41 | proced ure imgPre vMonthMous eDown(Send er: TObjec t; Button: TMouseBut ton; | |
42 | Shif t: TShiftS tate; X, Y : Integer) ; | |
43 | proced ure imgNex tMonthMous eDown(Send er: TObjec t; Button: TMouseBut ton; | |
44 | Shif t: TShiftS tate; X, Y : Integer) ; | |
45 | proced ure imgPre vMonthMous eUp(Sender : TObject; Button: T MouseButto n; | |
46 | Shif t: TShiftS tate; X, Y : Integer) ; | |
47 | proced ure imgNex tMonthMous eUp(Sender : TObject; Button: T MouseButto n; | |
48 | Shif t: TShiftS tate; X, Y : Integer) ; | |
49 | proced ure cmdMid nightClick (Sender: T Object); | |
50 | private | |
51 | FFromS elf: Boole an; | |
52 | FNowPr essed: Bo olean; | |
53 | TimeIs Required: Boolean; | |
54 | protecte d | |
55 | proced ure Loaded ; override ; | |
56 | end; | |
57 | ||
58 | { TORDat eTimeDlg } | |
59 | ||
60 | TORDateT imeDlg = c lass(TComp onent) | |
61 | private | |
62 | FDateT ime: T DateTime; | |
63 | FDateO nly: B oolean; | |
64 | FRequi reTime: B oolean; | |
65 | FRelat iveTime: s tring; | |
66 | functi on GetFMDa teTime: TF MDateTime; | |
67 | proced ure SetDat eOnly(Valu e: Boolean ); | |
68 | proced ure SetFMD ateTime(Va lue: TFMDa teTime); | |
69 | proced ure SetReq uireTime(V alue: Bool ean); | |
70 | public | |
71 | constr uctor Crea te(AOwner: TComponen t); overri de; | |
72 | functi on Execute : Boolean; | |
73 | proper ty Relativ eTime: str ing re ad FRelati veTime; | |
74 | publishe d | |
75 | proper ty FMDateT ime: TFMD ateTime re ad GetFMDa teTime w rite SetFM DateTime; | |
76 | proper ty DateOnl y: Bool ean re ad FDateOn ly w rite SetDa teOnly; | |
77 | proper ty Require Time: Bool ean re ad FRequir eTime w rite SetRe quireTime; | |
78 | end; | |
79 | ||
80 | // 508 c lass | |
81 | TORDateB utton = cl ass (TBitB tn); | |
82 | ||
83 | { TORDat eBox } | |
84 | ||
85 | TORDateE dit = clas s(TEdit) | |
86 | protecte d | |
87 | proced ure Create Params(var Params: T CreatePara ms); overr ide; | |
88 | end; | |
89 | ||
90 | TORDateB ox = class (TORDateEd it, IVADyn amicProper ty, IORBla ckColorMod eCompatibl e) | |
91 | private | |
92 | FFMDat eTime: TFM DateTime; | |
93 | FDateO nly: Boole an; | |
94 | FRequi reTime: Bo olean; | |
95 | FButto n: TORDate Button; | |
96 | FForma t: string; | |
97 | FTimeI sNow: Bool ean; | |
98 | FTempl ateField: boolean; | |
99 | FCapti on: TStati cText; | |
100 | FBlack ColorMode: boolean; | |
101 | FOnDat eDialogClo sed : TNot ifyEvent; | |
102 | proced ure Button Click(Send er: TObjec t); | |
103 | functi on GetFMDa teTime: TF MDateTime; | |
104 | functi on GetRela tiveTime: string; | |
105 | proced ure SetDat eOnly(Valu e: Boolean ); | |
106 | proced ure SetFMD ateTime(Va lue: TFMDa teTime); | |
107 | proced ure SetEdi tRect; | |
108 | proced ure SetReq uireTime(V alue: Bool ean); | |
109 | proced ure Update Text; | |
110 | proced ure WMSize (var Messa ge: TWMSiz e); messag e WM_SIZE; | |
111 | proced ure SetTem plateField (const Val ue: boolea n); | |
112 | proced ure SetCap tion(const Value: st ring); | |
113 | functi on GetCap tion(): st ring; | |
114 | protecte d | |
115 | proced ure Change ; override ; | |
116 | proced ure KeyDow n(var Key: Word; Shi ft: TShift State); ov erride; | |
117 | proper ty DateBut ton: TORDa teButton r ead FButto n; | |
118 | proced ure SetEna bled(Value : Boolean) ; override ; //wat v2 8 when di sabling TO RDateBox, button sti ll appears active, t his addres ses that | |
119 | public | |
120 | constr uctor Crea te(AOwner: TComponen t); overri de; | |
121 | functi on IsValid : Boolean; | |
122 | proced ure Valida te(var Err Msg: strin g); | |
123 | proced ure SetBla ckColorMod e(Value: b oolean); | |
124 | functi on Support sDynamicPr operty(Pro pertyID: i nteger): b oolean; | |
125 | functi on GetDyna micPropert y(Property ID: intege r): string ; | |
126 | proper ty Format: string re ad FFormat write FFo rmat; | |
127 | proper ty Relativ eTime: str ing re ad GetRela tiveTime; | |
128 | proper ty Templat eField: bo olean read FTemplate Field writ e SetTempl ateField; | |
129 | publishe d | |
130 | proper ty FMDateT ime: TFMD ateTime re ad GetFMDa teTime wr ite SetFMD ateTime; | |
131 | proper ty DateOnl y: Bool ean re ad FDateOn ly writ e SetDateO nly; | |
132 | proper ty Require Time: Bool ean re ad FRequir eTime writ e SetRequi reTime; | |
133 | proper ty Caption : string r ead GetCap tion write SetCaptio n; | |
134 | proper ty OnDateD ialogClose d: TNotify Event read FOnDateDi alogClosed write FOn DateDialog Closed; | |
135 | end; | |
136 | ||
137 | // 508 c lasses | |
138 | TORDayCo mbo = clas s (TORComb oBox); | |
139 | TORMonth Combo = cl ass (TORCo mboBox); | |
140 | TORYearE dit = clas s(TMaskEdi t) | |
141 | private | |
142 | FTempl ateField: boolean; | |
143 | proced ure SetTem plateField (const Val ue: boolea n); | |
144 | protecte d | |
145 | proper ty Templat eField: bo olean read FTemplate Field writ e SetTempl ateField; | |
146 | end; | |
147 | ||
148 | TORYearE ditClass = Class of TORYearEdi t; | |
149 | ||
150 | TORDateC ombo = cla ss(TCustom Panel, IOR BlackColor ModeCompat ible) | |
151 | private | |
152 | FYearC hanging: b oolean; | |
153 | FMonth Combo: TOR MonthCombo ; | |
154 | FDayCo mbo: TORDa yCombo; | |
155 | FYearE dit: TORYe arEdit; | |
156 | FYearU D: TUpDown ; | |
157 | FCalBt n: TORDate Button; | |
158 | FInclu deMonth: b oolean; | |
159 | FInclu deDay: boo lean; | |
160 | FInclu deBtn: boo lean; | |
161 | FLongM onths: boo lean; | |
162 | FMonth : integer; | |
163 | FDay: integer; | |
164 | FYear: integer; | |
165 | FCtrls Created: b oolean; | |
166 | FOnCha nge: TNoti fyEvent; | |
167 | FRebui lding: boo lean; | |
168 | FTempl ateField: boolean; | |
169 | FBlack ColorMode: boolean; | |
170 | FORYea rEditClass : TORYearE ditClass; | |
171 | proced ure SetInc ludeBtn(co nst Value: boolean); | |
172 | proced ure SetInc ludeDay(Va lue: boole an); | |
173 | proced ure SetInc ludeMonth( const Valu e: boolean ); | |
174 | proced ure SetLon gMonths(co nst Value: boolean); | |
175 | proced ure SetDay (Value: in teger); | |
176 | proced ure SetMon th(Value: integer); | |
177 | proced ure SetYea r(const Va lue: integ er); | |
178 | functi on GetFMDa te: TFMDat eTime; | |
179 | proced ure SetFMD ate(const Value: TFM DateTime); | |
180 | proced ure CMFont Changed(va r Message: TMessage) ; message CM_FONTCHA NGED; | |
181 | proced ure SetTem plateField (const Val ue: boolea n); | |
182 | protecte d | |
183 | proced ure Rebuil d; virtual ; | |
184 | functi on InitDay s(GetSize: boolean): integer; | |
185 | functi on InitMon ths(GetSiz e: boolean ): integer ; | |
186 | functi on GetYear Size: inte ger; | |
187 | proced ure DoChan ge; | |
188 | proced ure MonthC hanged(Sen der: TObje ct); | |
189 | proced ure DayCha nged(Sende r: TObject ); | |
190 | proced ure YearCh anged(Send er: TObjec t); | |
191 | proced ure BtnCli cked(Sende r: TObject ); | |
192 | proced ure YearUD Change(Sen der: TObje ct; var Al lowChange: Boolean; | |
193 | // 2FA NewValu e: Smallin t; Directi on: TUpDow nDirection ); | |
194 | NewV alue: Inte ger; Direc tion: TUpD ownDirecti on); | |
195 | proced ure YearKe yPress(Sen der: TObje ct; var Ke y: Char); | |
196 | proced ure CheckD ays; | |
197 | proced ure Loaded ; override ; | |
198 | proced ure Paint; override; | |
199 | proced ure Resize d(Sender: TObject); | |
200 | proper ty MonthCo mbo: TORMo nthCombo r ead FMonth Combo; | |
201 | proper ty DayComb o: TORDayC ombo read FDayCombo; | |
202 | proper ty YearEdi t: TORYear Edit read FYearEdit; | |
203 | proper ty YearUD: TUpDown r ead FYearU D; | |
204 | proper ty CalBtn: TORDateBu tton read FCalBtn; | |
205 | proper ty ORYearE ditClass: TORYearEdi tClass rea d FORYearE ditClass w rite FORYe arEditClas s; | |
206 | public | |
207 | constr uctor Crea te(AOwner: TComponen t); overri de; | |
208 | destru ctor Destr oy; overri de; | |
209 | functi on DateTex t: string; | |
210 | proced ure SetBla ckColorMod e(Value: b oolean); | |
211 | proper ty Templat eField: bo olean read FTemplate Field writ e SetTempl ateField; | |
212 | proper ty FMDate: TFMDateTi me read Ge tFMDate wr ite SetFMD ate; | |
213 | publishe d | |
214 | functi on Text: s tring; | |
215 | proper ty Include Btn: boole an read FI ncludeBtn write SetI ncludeBtn; | |
216 | proper ty Include Day: boole an read FI ncludeDay write SetI ncludeDay; | |
217 | proper ty Include Month: boo lean read FIncludeMo nth write SetInclude Month; | |
218 | proper ty LongMon ths: boole an read FL ongMonths write SetL ongMonths default FA LSE; | |
219 | proper ty Month: integer re ad FMonth write SetM onth; | |
220 | proper ty Day: in teger read FDay writ e SetDay; | |
221 | proper ty Year: i nteger rea d FYear wr ite SetYea r; | |
222 | proper ty OnChang e: TNotify Event read FOnChange write FOn Change; | |
223 | proper ty Anchors ; | |
224 | proper ty Enabled ; | |
225 | proper ty Font; | |
226 | proper ty ParentC olor; | |
227 | proper ty ParentF ont; | |
228 | proper ty TabOrde r; | |
229 | proper ty TabStop ; | |
230 | proper ty Visible ; | |
231 | end; | |
232 | ||
233 | function I sLeapYear( AYear: Int eger): Boo lean; | |
234 | function D aysPerMont h(AYear, A Month: Int eger): Int eger; | |
235 | ||
236 | procedure Register; | |
237 | ||
238 | implementa tion | |
239 | ||
240 | {$R *.DFM} | |
241 | {$R ORDtTm } | |
242 | ||
243 | const | |
244 | FMT_DATE TIME = 'mm m d,yyyy@h h:nn'; | |
245 | FMT_DATE ONLY = 'mm m d,yyyy'; | |
246 | (* | |
247 | HOURS_AM PM: array[ 0..23] of string[3] = | |
248 | ('12a' ,' 1',' 2',' 3',' 4',' 5' ,' 6',' 7',' 8',' 9','10 ' ,'11 ', | |
249 | '12p' ,' 1',' 2',' 3',' 4',' 5' ,' 6',' 7',' 8',' 9','10 ' ,'11 '); | |
250 | HOURS_MI L: array[ 0..23] of string[2] = | |
251 | ('00', '01','02', '03','04', '05','06', '07','08', '09','10', '11', | |
252 | '12', '13','14', '15','16', '17','18', '19','20', '21','22', '23'); | |
253 | *) | |
254 | AdjVertS ize = 8; | |
255 | FontHeig htText = ' BEFHILMSTV WXZfgjmpqt yk'; | |
256 | ||
257 | var | |
258 | uServerT oday: TFMD ateTime; | |
259 | ||
260 | { Server-d ependent f unctions - ---------- ---------- ---------- ---------- ---------- ---------- --- } | |
261 | ||
262 | function A ctiveBroke r: Boolean ; | |
263 | begin | |
264 | Result : = False; | |
265 | if (RPCB rokerV <> nil) and R PCBrokerV. Connected then Resul t := True; | |
266 | end; | |
267 | ||
268 | function S erverFMNow : TFMDateT ime; | |
269 | begin | |
270 | if Activ eBroker | |
271 | then R esult := S trToFloat( sCallV('OR WU DT', [' NOW'])) | |
272 | else R esult := D ateTimeToF MDateTime( Now); | |
273 | end; | |
274 | ||
275 | function S erverNow: TDateTime; | |
276 | begin | |
277 | if Activ eBroker | |
278 | then R esult := F MDateTimeT oDateTime( ServerFMNo w) | |
279 | else R esult := N ow; | |
280 | end; | |
281 | ||
282 | function S erverToday : TDateTim e; | |
283 | begin | |
284 | if uServ erToday = 0 then uSe rverToday := Int(Ser verFMNow); | |
285 | Result : = FMDateTi meToDateTi me(uServer Today); | |
286 | end; | |
287 | ||
288 | (* | |
289 | function S erverFMTod ay: TFMDat eTime; // never r eferenced in this un it | |
290 | begin | |
291 | if uServ erToday = 0 then uSe rverToday := Int(Ser verFMNow); | |
292 | Result : = uServerT oday; | |
293 | end; | |
294 | *) | |
295 | ||
296 | function S erverParse FMDate(con st AString : string): TFMDateTi me; | |
297 | begin | |
298 | if Activ eBroker | |
299 | then R esult := S trToFloat( sCallV('OR WU DT', [A String, 'T SX'])) | |
300 | else R esult := 0 ; | |
301 | end; | |
302 | ||
303 | function R elativeDat eTime(ADat eTime: TDa teTime): s tring; | |
304 | var | |
305 | Offset: Integer; | |
306 | h,n,s,l: Word; | |
307 | ATime: s tring; | |
308 | begin | |
309 | Offset : = Trunc(In t(ADateTim e) - Int(S erverToday )); | |
310 | if Offse t < 0 then Result := 'T' + Int ToStr(Offs et) | |
311 | else if Offset = 0 then Resu lt := 'T' | |
312 | else Res ult := 'T+ ' + IntToS tr(Offset) ; | |
313 | DecodeTi me(ADateTi me, h, n, s, l); | |
314 | ATime := Format('@ %.2d:%.2d' , [h, n]); | |
315 | if ATime <> '@00:0 0' then Re sult := Re sult + ATi me; | |
316 | end; | |
317 | ||
318 | procedure LoadEllips is(bitmap: TBitMap; BlackColor Mode: bool ean); | |
319 | var | |
320 | ResName: string; | |
321 | begin | |
322 | if Black ColorMode then | |
323 | ResNam e := 'BLAC K_BMP_ELLI PSIS' | |
324 | else | |
325 | ResNam e := 'BMP_ ELLIPSIS'; | |
326 | bitmap.L oadFromRes ourceName( hInstance, ResName); | |
327 | end; | |
328 | ||
329 | { TfrmORDt Tm ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- --- } | |
330 | ||
331 | procedure TORfrmDtTm .FormCreat e(Sender: TObject); | |
332 | begin | |
333 | ResizeAn choredForm ToFont(sel f); | |
334 | //FormSt yle := fsS tayOnTop; | |
335 | lstHour. TopIndex : = 6; | |
336 | FFromSel f := False ; | |
337 | calSelec tChange(Se lf); | |
338 | end; | |
339 | ||
340 | procedure TORfrmDtTm .calSelect Change(Sen der: TObje ct); | |
341 | begin | |
342 | lblDate. Caption := FormatDat eTime('mmm m d, yyyy' , calSelec t.Calendar Date); | |
343 | FNowPres sed := Fal se; | |
344 | end; | |
345 | ||
346 | procedure TORfrmDtTm .imgPrevMo nthMouseDo wn(Sender: TObject; | |
347 | Button: TMouseButt on; Shift: TShiftSta te; X, Y: Integer); | |
348 | begin | |
349 | pnlPrevM onth.Bevel Outer := b vLowered; | |
350 | end; | |
351 | ||
352 | procedure TORfrmDtTm .imgNextMo nthMouseDo wn(Sender: TObject; | |
353 | Button: TMouseButt on; Shift: TShiftSta te; X, Y: Integer); | |
354 | begin | |
355 | pnlNextM onth.Bevel Outer := b vLowered; | |
356 | end; | |
357 | ||
358 | procedure TORfrmDtTm .imgPrevMo nthClick(S ender: TOb ject); | |
359 | begin | |
360 | calSelec t.PrevMont h; | |
361 | end; | |
362 | ||
363 | procedure TORfrmDtTm .imgNextMo nthClick(S ender: TOb ject); | |
364 | begin | |
365 | calSelec t.NextMont h; | |
366 | end; | |
367 | ||
368 | procedure TORfrmDtTm .imgPrevMo nthMouseUp (Sender: T Object; | |
369 | Button: TMouseButt on; Shift: TShiftSta te; X, Y: Integer); | |
370 | begin | |
371 | pnlPrevM onth.Bevel Outer := b vRaised; | |
372 | end; | |
373 | ||
374 | procedure TORfrmDtTm .imgNextMo nthMouseUp (Sender: T Object; | |
375 | Button: TMouseButt on; Shift: TShiftSta te; X, Y: Integer); | |
376 | begin | |
377 | pnlNext Month.Beve lOuter := bvRaised; | |
378 | end; | |
379 | ||
380 | procedure TORfrmDtTm .cmdTodayC lick(Sende r: TObject ); | |
381 | begin | |
382 | calSelec t.Calendar Date := Se rverToday; | |
383 | lstHour. ItemIndex := -1; | |
384 | lstMinut e.ItemInde x := -1; | |
385 | txtTime. Text := '' ; | |
386 | end; | |
387 | ||
388 | procedure TORfrmDtTm .txtTimeCh ange(Sende r: TObject ); | |
389 | begin | |
390 | if not F FromSelf t hen | |
391 | begin | |
392 | lstHou r.ItemInde x := -1; | |
393 | lstMin ute.ItemIn dex := -1; | |
394 | end; | |
395 | FNowPres sed := Fal se; | |
396 | end; | |
397 | ||
398 | procedure TORfrmDtTm .lstHourCl ick(Sender : TObject) ; | |
399 | begin | |
400 | if lstHo ur.ItemInd ex = 0 the n lstMinut e.Items[0] := ':01 --' else l stMinute.I tems[0] := ':00 --' ; //<----- - NEW CODE | |
401 | if lstMi nute.ItemI ndex < 0 t hen lstMin ute.ItemIn dex := 0; | |
402 | lstMinut eClick(Sel f); | |
403 | end; | |
404 | ||
405 | procedure TORfrmDtTm .lstMinute Click(Send er: TObjec t); | |
406 | var | |
407 | AnHour, AMinute: I nteger; | |
408 | // AmPm: string; | |
409 | begin | |
410 | if lstHo ur.ItemInd ex < 0 the n Exit; | |
411 | ||
412 | // if am pm time - | |
413 | //case l stHour.Ite mIndex of | |
414 | // 0: AnHour := 12; | |
415 | //1..12: AnHour := lstHour.I temIndex; | |
416 | //else AnHour := lstHour.I temIndex - 12; | |
417 | //end; | |
418 | //if lst Hour.ItemI ndex > 11 then AmPm := 'PM' el se AmPm := 'AM'; | |
419 | ||
420 | // if mi litary tim e | |
421 | AnHour : = lstHour. ItemIndex; | |
422 | ||
423 | AMinute := lstMinu te.ItemInd ex * 5; | |
424 | if (AnHo ur = 0) an d (AMinute = 0) then AMinute : = 1; //<- ---------- --- NEW CO DE | |
425 | FFromSel f := True; | |
426 | // if am pm time - | |
427 | //txtTim e.Text := Format('%d :%.2d ' + AmPm, [AnH our, AMinu te]); | |
428 | ||
429 | // if mi litary tim e | |
430 | txtTime. Text := Fo rmat('%.2d :%.2d ', [ AnHour, AM inute]); | |
431 | ||
432 | FFromSel f := False ; | |
433 | end; | |
434 | ||
435 | procedure TORfrmDtTm .cmdNowCli ck(Sender: TObject); | |
436 | begin | |
437 | calSelec t.Calendar Date := Se rverToday; | |
438 | //txtTim e.Text := FormatDate Time('h:nn ampm', Se rverNow); // if amp m time | |
439 | txtTime. Text := Fo rmatDateTi me('hh:nn' , ServerNo w); // if amp m time | |
440 | FNowPres sed := Tru e; | |
441 | end; | |
442 | ||
443 | procedure TORfrmDtTm .cmdMidnig htClick(Se nder: TObj ect); | |
444 | begin | |
445 | //txtTim e.Text := '11:59 PM' ; // if a mpm time | |
446 | txtTime. Text := '2 3:59'; // if mi litary tim e | |
447 | end; | |
448 | ||
449 | procedure TORfrmDtTm .cmdOKClic k(Sender: TObject); | |
450 | var | |
451 | x: strin g; | |
452 | begin | |
453 | if TimeI sRequired and (Lengt h(txtTime. Text) = 0) then | |
454 | begin | |
455 | InfoBo x('An entr y for time is requir ed.', 'Mis sing Time' , MB_OK); | |
456 | Exit; | |
457 | end; | |
458 | if Lengt h(txtTime. Text) > 0 then | |
459 | begin | |
460 | x := T rim(txtTim e.Text); | |
461 | //if ( x='00:00') or (x='0: 00') or (x ='00:00:00 ') or (x=' 0:00:00') then x := '00:00:01' ; | |
462 | if (x= '00:00') o r (x='0:00 ') or (x=' 00:00:00') or (x='0: 00:00') th en x := '0 0:01'; // <------- C HANGED COD E | |
463 | StrToT ime(x); | |
464 | txtTim e.Text := x; | |
465 | end; | |
466 | ModalRes ult := mrO K; | |
467 | end; | |
468 | ||
469 | procedure TORfrmDtTm .cmdCancel Click(Send er: TObjec t); | |
470 | begin | |
471 | ModalRes ult := mrC ancel; | |
472 | end; | |
473 | ||
474 | procedure TORfrmDtTm .Loaded; | |
475 | begin | |
476 | inherite d Loaded; | |
477 | UpdateCo lorsFor508 Compliance (Self); | |
478 | end; | |
479 | ||
480 | { TORDateT imeDlg } | |
481 | ||
482 | constructo r TORDateT imeDlg.Cre ate(AOwner : TCompone nt); | |
483 | begin | |
484 | inherite d Create(A Owner); | |
485 | if not ( csDesignin g in Compo nentState) | |
486 | then F DateTime : = ServerTo day | |
487 | else F DateTime := SysUtil s.Date; | |
488 | end; | |
489 | ||
490 | function T ORDateTime Dlg.Execut e: Boolean ; | |
491 | const | |
492 | HORZ_SPA CING = 8; | |
493 | var | |
494 | frmDtTm: TORfrmDtT m; | |
495 | begin | |
496 | frmDtTm := TORfrmD tTm.Create (Applicati on); | |
497 | try | |
498 | with f rmDtTm do | |
499 | begin | |
500 | calS elect.Cale ndarDate : = Int(FDat eTime); | |
501 | if F rac(FDateT ime) > 0 | |
502 | // then txtTi me.Text := FormatDat eTime('h:n n ampm', F DateTime); // if am pm time | |
503 | th en txtTime .Text := F ormatDateT ime('hh:nn ', FDateTi me); // if mi litary tim e | |
504 | if R equireTime then Time IsRequired := True; | |
505 | if D ateOnly th en | |
506 | begi n | |
507 | tx tTime.Visi ble := False; | |
508 | ls tHour.Visi ble := False; | |
509 | ls tMinute.Vi sible := False; | |
510 | cm dNow.Visib le := False; | |
511 | cm dMidnight. Visible := False; | |
512 | bv lFrame.Wid th := bvlF rame.Width - txtTime .Width - H ORZ_SPACIN G; | |
513 | cm dOK.Left : = cmdOK.Le ft - txtTi me.Width - HORZ_SPAC ING; | |
514 | cm dCancel.Le ft := cmdO K.Left; | |
515 | Cl ientWidth := ClientW idth - txt Time.Width - HORZ_SP ACING; | |
516 | end; | |
517 | Resu lt := (Sho wModal = I DOK); | |
518 | if R esult then | |
519 | begi n | |
520 | FD ateTime := Int(calSe lect.Calen darDate); | |
521 | if Length(tx tTime.Text ) > 0 then FDateTime := FDateT ime + StrT oTime(txtT ime.Text); | |
522 | if FNowPress ed | |
523 | then FRela tiveTime : = 'NOW' | |
524 | else FRela tiveTime : = Relative DateTime(F DateTime); | |
525 | end; | |
526 | end; | |
527 | finally | |
528 | frmDtT m.Free; | |
529 | end; | |
530 | end; | |
531 | ||
532 | function T ORDateTime Dlg.GetFMD ateTime: T FMDateTime ; | |
533 | begin | |
534 | Result : = DateTime ToFMDateTi me(FDateTi me); | |
535 | end; | |
536 | ||
537 | procedure TORDateTim eDlg.SetDa teOnly(Val ue: Boolea n); | |
538 | begin | |
539 | FDateOnl y := Value ; | |
540 | if FDate Only then | |
541 | begin | |
542 | FRequi reTime := False; | |
543 | FDateT ime := Int (FDateTime ); | |
544 | end; | |
545 | end; | |
546 | ||
547 | procedure TORDateTim eDlg.SetFM DateTime(V alue: TFMD ateTime); | |
548 | begin | |
549 | if Value > 0 then FDateTime := FMDateT imeToDateT ime(Value) ; | |
550 | end; | |
551 | ||
552 | procedure TORDateTim eDlg.SetRe quireTime( Value: Boo lean); | |
553 | begin | |
554 | FRequire Time := Va lue; | |
555 | if FRequ ireTime th en FDateOn ly := Fals e; | |
556 | end; | |
557 | ||
558 | { TORDateE dit ------ ---------- ---------- ---------- ---------- ---------- ---------- ---------- - } | |
559 | ||
560 | procedure TORDateEdi t.CreatePa rams(var P arams: TCr eateParams ); | |
561 | { sets a o ne line ed it box to multiline style so t he editing rectangle can be ch anged } | |
562 | begin | |
563 | inherite d CreatePa rams(Param s); | |
564 | Params.S tyle := Pa rams.Style or ES_MUL TILINE or WS_CLIPCHI LDREN; | |
565 | end; | |
566 | ||
567 | ||
568 | { TORDateB ox ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- --- } | |
569 | ||
570 | constructo r TORDateB ox.Create( AOwner: TC omponent); | |
571 | begin | |
572 | inherite d Create(A Owner); | |
573 | FButton := TORDate Button.Cre ate(Self); | |
574 | FButton. Parent := Self; | |
575 | FButton. Width := 1 8; | |
576 | FButton. Height := 17; | |
577 | FButton. OnClick := ButtonCli ck; | |
578 | FButton. TabStop := False; | |
579 | FBlackCo lorMode := False; | |
580 | LoadElli psis(FButt on.Glyph, FALSE); | |
581 | FButton. Visible := True; | |
582 | FFormat := FMT_DAT ETIME; | |
583 | end; | |
584 | ||
585 | procedure TORDateBox .WMSize(va r Message: TWMSize); | |
586 | var | |
587 | ofs: int eger; | |
588 | ||
589 | begin | |
590 | inherite d; | |
591 | if assig ned(FButto n) then | |
592 | begin | |
593 | if Bor derStyle = bsNone th en | |
594 | ofs := 0 | |
595 | else | |
596 | ofs := 4; | |
597 | FButto n.SetBound s(Width - FButton.Wi dth - ofs, 0, FButto n.Width, H eight - of s); | |
598 | end; | |
599 | SetEditR ect; | |
600 | end; | |
601 | ||
602 | procedure TORDateBox .SetTempla teField(co nst Value: boolean); | |
603 | var | |
604 | Y: integ er; | |
605 | ||
606 | begin | |
607 | if(FTemp lateField <> Value) then | |
608 | begin | |
609 | FTempl ateField : = Value; | |
610 | Y := T extHeightB yFont(Font .Handle, F ontHeightT ext); | |
611 | if Val ue then | |
612 | begin | |
613 | FBut ton.Width := Y+2; | |
614 | Heig ht := Y; | |
615 | Bord erStyle := bsNone; | |
616 | end | |
617 | else | |
618 | begin | |
619 | FBut ton.Width := 18; | |
620 | Heig ht := y + AdjVertSiz e; | |
621 | Bord erStyle := bsSingle; | |
622 | end; | |
623 | end; | |
624 | end; | |
625 | ||
626 | function T ORDateBox. SupportsDy namicPrope rty(Proper tyID: inte ger): bool ean; | |
627 | begin | |
628 | Result : = (Propert yID = Dyna PropAccesi bilityCapt ion); | |
629 | end; | |
630 | ||
631 | procedure TORDateBox .ButtonCli ck(Sender: TObject); | |
632 | var | |
633 | DateDial og: TORDat eTimeDlg; | |
634 | ParsedDa te: TFMDat eTime; | |
635 | begin | |
636 | DateDial og := TORD ateTimeDlg .Create(Ap plication) ; | |
637 | if Lengt h(Text) > 0 then | |
638 | begin | |
639 | Parsed Date := Se rverParseF MDate(Text ); | |
640 | if Par sedDate > -1 then FF MDateTime := ParsedD ate else F FMDateTime := 0; | |
641 | end; | |
642 | DateDial og.DateOnl y := FDate Only; | |
643 | DateDial og.FMDateT ime := FFM DateTime; | |
644 | DateDial og.Require Time := FR equireTime ; | |
645 | if DateD ialog.Exec ute then | |
646 | begin | |
647 | FFMDat eTime := D ateDialog. FMDateTime ; | |
648 | Update Text; | |
649 | FTimeI sNow := Da teDialog.R elativeTim e = 'NOW'; | |
650 | end; | |
651 | DateDial og.Free; | |
652 | if Assig ned(OnDate DialogClos ed) then O nDateDialo gClosed(Se lf); | |
653 | if Visib le and Ena bled then //Some eve nts may hi de the com ponent | |
654 | SetFoc us; | |
655 | end; | |
656 | ||
657 | procedure TORDateBox .Change; | |
658 | begin | |
659 | inherite d Change; | |
660 | FTimeIsN ow := Fals e; | |
661 | end; | |
662 | ||
663 | procedure TORDateBox .KeyDown(v ar Key: Wo rd; Shift: TShiftSta te); | |
664 | begin | |
665 | inherite d KeyDown( Key, Shift ); | |
666 | if (Key = VK_RETUR N) then be gin | |
667 | FButto n.Click; | |
668 | Key := 0; | |
669 | end; | |
670 | end; | |
671 | ||
672 | function T ORDateBox. GetFMDateT ime: TFMDa teTime; | |
673 | begin | |
674 | Result : = 0; | |
675 | if Lengt h(Text) > 0 then Res ult := Ser verParseFM Date(Text) ; | |
676 | FFMDateT ime := Res ult; | |
677 | end; | |
678 | ||
679 | function T ORDateBox. GetRelativ eTime: str ing; | |
680 | begin | |
681 | Result : = ''; | |
682 | if FTime IsNow then Result := 'NOW' | |
683 | else if UpperCase( Text) = 'N OW' then R esult := ' NOW' | |
684 | else if Length(Tex t) > 0 the n | |
685 | begin | |
686 | FFMDat eTime := S erverParse FMDate(Tex t); | |
687 | if FFM DateTime > 0 then Re sult := Re lativeDate Time(FMDat eTimeToDat eTime(FFMD ateTime)); | |
688 | end; | |
689 | end; | |
690 | ||
691 | procedure TORDateBox .SetDateOn ly(Value: Boolean); | |
692 | begin | |
693 | FDateOnl y := Value ; | |
694 | if FDate Only then | |
695 | begin | |
696 | FRequi reTime := False; | |
697 | FFMDat eTime := I nt(FFMDate Time); | |
698 | if FFo rmat = FMT _DATETIME then FForm at := FMT_ DATEONLY; | |
699 | end; | |
700 | UpdateTe xt; | |
701 | end; | |
702 | ||
703 | procedure TORDateBox .SetFMDate Time(Value : TFMDateT ime); | |
704 | begin | |
705 | FFMDateT ime := Val ue; | |
706 | UpdateTe xt; | |
707 | end; | |
708 | ||
709 | procedure TORDateBox .SetRequir eTime(Valu e: Boolean ); | |
710 | begin | |
711 | FRequire Time := Va lue; | |
712 | if FRequ ireTime th en | |
713 | begin | |
714 | if FFo rmat = FMT _DATEONLY then FForm at := FMT_ DATETIME; | |
715 | SetDat eOnly(Fals e); | |
716 | end; | |
717 | end; | |
718 | ||
719 | procedure TORDateBox .SetEditRe ct; | |
720 | { change t he edit re ctangle to not hide the calend ar button - taken fr om SPIN.PA S sample } | |
721 | var | |
722 | Loc: TRe ct; | |
723 | begin | |
724 | SendMess age(Handle , EM_GETRE CT, 0, Lon gInt(@Loc) ); | |
725 | Loc.Bott om := Clie ntHeight + 1; // +1 is wor karound fo r windows paint bug | |
726 | Loc.Righ t := FBut ton.Left - 2; | |
727 | Loc.Top := 0; | |
728 | Loc.Left := 0; | |
729 | SendMess age(Handle , EM_SETRE CTNP, 0, L ongInt(@Lo c)); | |
730 | end; | |
731 | ||
732 | procedure TORDateBox .UpdateTex t; | |
733 | begin | |
734 | if FFMDa teTime > 0 then | |
735 | begin | |
736 | if (FF ormat =FMT _DATETIME) and (Frac (FFMDateTi me) = 0) | |
737 | then Text := F ormatFMDat eTime(FMT_ DATEONLY, FFMDateTim e) | |
738 | else Text := F ormatFMDat eTime(FFor mat, FFMDa teTime); | |
739 | end; | |
740 | end; | |
741 | ||
742 | procedure TORDateBox .Validate( var ErrMsg : string); | |
743 | begin | |
744 | ErrMsg : = ''; | |
745 | if Lengt h(Text) > 0 then | |
746 | begin | |
747 | { | |
748 | !!!!!! THI S HAS BEEN REMOVED A S IT CAUSE D PROBLEMS WITH REMI NDER DIALO GS - DN S BELLC !!!! !! | |
749 | //We n eed to mak e sure tha t there is a date en tered befo re parse | |
750 | if FRe quireTime and ((Pos( '@', Text) = 0) or ( Length(Pie ce(Text, ' @', 1)) = 0)) then | |
751 | ErrMs g := 'Date Required' ; | |
752 | } | |
753 | FFMDat eTime := S erverParse FMDate(Tex t); | |
754 | if FFM DateTime < = 0 then E rrmsg := ' Invalid Da te/Time'; | |
755 | if FRe quireTime and (Frac( FFMDateTim e) = 0) th en ErrMsg := 'Time R equired'; | |
756 | if FDa teOnly and (Frac( FFMDateTim e) > 0) th en ErrMsg := 'Time n ot Require d'; | |
757 | end; | |
758 | end; | |
759 | ||
760 | function T ORDateBox. IsValid: B oolean; | |
761 | var | |
762 | x: strin g; | |
763 | begin | |
764 | Validate (x); | |
765 | if Lengt h(x) = 0 t hen Result := True e lse Result := False; | |
766 | if Lengt h(Text) = 0 then Res ult := Fal se; | |
767 | end; | |
768 | ||
769 | procedure TORDateBox .SetBlackC olorMode(V alue: bool ean); | |
770 | begin | |
771 | if FBlac kColorMode <> Value then | |
772 | begin | |
773 | FBlack ColorMode := Value; | |
774 | LoadEl lipsis(FBu tton.Glyph , FBlackCo lorMode); | |
775 | end; | |
776 | end; | |
777 | ||
778 | procedure TORDateBox .SetCaptio n(const Va lue: strin g); | |
779 | begin | |
780 | if not Assigned( FCaption) then begin | |
781 | FCa ption := T StaticText .Create(se lf); | |
782 | FCa ption.Auto Size := Fa lse; | |
783 | FCa ption.Heig ht := 0; | |
784 | FCa ption.Widt h := 0; | |
785 | FCa ption.Visi ble := Tru e; | |
786 | FCa ption.Pare nt := Pare nt; | |
787 | FCa ption.Brin gtoFront; | |
788 | end; | |
789 | FCapti on.Caption := Value; | |
790 | end; | |
791 | ||
792 | procedure TORDateBox .SetEnable d(Value: B oolean); | |
793 | begin | |
794 | FButton. Enabled := Value; | |
795 | inherite d; | |
796 | end; | |
797 | ||
798 | function T ORDateBox. GetCaption (): string ; | |
799 | begin | |
800 | result := FCapti on.Caption ; | |
801 | end; | |
802 | ||
803 | function T ORDateBox. GetDynamic Property(P ropertyID: integer): string; | |
804 | begin | |
805 | if Prope rtyID = Dy naPropAcce sibilityCa ption then | |
806 | Result := GetCap tion | |
807 | else | |
808 | Result := ''; | |
809 | end; | |
810 | ||
811 | function I sLeapYear( AYear: Int eger): Boo lean; | |
812 | begin | |
813 | Result : = (AYear m od 4 = 0) and ((AYea r mod 100 <> 0) or ( AYear mod 400 = 0)); | |
814 | end; | |
815 | ||
816 | function D aysPerMont h(AYear, A Month: Int eger): Int eger; | |
817 | const | |
818 | DaysInMo nth: array [1..12] of Integer = (31, 28, 31, 30, 31 , 30, 31, 31, 30, 31 , 30, 31); | |
819 | ||
820 | begin | |
821 | if(AYear < 1) or ( AMonth < 1 ) then | |
822 | Result := 0 | |
823 | else | |
824 | begin | |
825 | Result := DaysIn Month[AMon th]; | |
826 | if (AM onth = 2) and IsLeap Year(AYear ) then Inc (Result); { leap-yea r Feb is s pecial } | |
827 | end; | |
828 | end; | |
829 | ||
830 | { TORDateC ombo ----- ---------- ---------- ---------- ---------- ---------- ---------- -------- } | |
831 | ||
832 | const | |
833 | ComboBox AdjSize = 24; | |
834 | EditAdjH orzSize = 8; | |
835 | DateComb oCtrlGap = 2; | |
836 | FirstYea r = 1800; | |
837 | LastYear = 2200; | |
838 | ||
839 | { TORDateC omboEdit } | |
840 | ||
841 | procedure TORYearEdi t.SetTempl ateField(c onst Value : boolean) ; | |
842 | begin | |
843 | if(FTemp lateField <> Value) then | |
844 | begin | |
845 | FTempl ateField : = Value; | |
846 | if Val ue then | |
847 | Bord erStyle := bsNone | |
848 | else | |
849 | Bord erStyle := bsSingle; | |
850 | end; | |
851 | end; | |
852 | ||
853 | { TORDateC ombo } | |
854 | ||
855 | constructo r TORDateC ombo.Creat e(AOwner: TComponent ); | |
856 | begin | |
857 | inherite d; | |
858 | ControlS tyle := Co ntrolStyle - [csSetC aption, cs AcceptsCon trols]; | |
859 | BevelOut er := bvNo ne; | |
860 | FInclude Month := T RUE; | |
861 | FInclude Day := TRU E; | |
862 | FInclude Btn := TRU E; | |
863 | OnResize := Resize d; | |
864 | FORYearE ditClass : = TORYearE dit; | |
865 | end; | |
866 | ||
867 | destructor TORDateCo mbo.Destro y; | |
868 | begin | |
869 | KillObj( @FMonthCom bo); | |
870 | KillObj( @FDayCombo ); | |
871 | KillObj( @FYearEdit ); | |
872 | KillObj( @FYearUD); | |
873 | KillObj( @FCalBtn); | |
874 | inherite d; | |
875 | end; | |
876 | ||
877 | function T ORDateComb o.GetYearS ize: integ er; | |
878 | begin | |
879 | Result : = TextWidt hByFont(Fo nt.Handle, '8888') + EditAdjHo rzSize; | |
880 | end; | |
881 | ||
882 | function T ORDateComb o.InitDays (GetSize: boolean): integer; | |
883 | var | |
884 | dy: inte ger; | |
885 | ||
886 | begin | |
887 | Result : = 0; | |
888 | if(assig ned(FDayCo mbo)) then | |
889 | begin | |
890 | dy := DaysPerMon th(FYear, FMonth) + 1; | |
891 | while (FDayCombo .Items.Cou nt < dy) d o | |
892 | begin | |
893 | if(F DayCombo.I tems.Count = 0) then | |
894 | FD ayCombo.It ems.Add(' ') | |
895 | else | |
896 | FD ayCombo.It ems.Add(in ttostr(FDa yCombo.Ite ms.Count)) ; | |
897 | end; | |
898 | while (FDayCombo .Items.Cou nt > dy) d o | |
899 | FDay Combo.Item s.Delete(F DayCombo.I tems.Count -1); | |
900 | if(Get Size) then | |
901 | Resu lt := Text WidthByFon t(Font.Han dle, '88') + ComboBo xAdjSize; | |
902 | if(FDa y > (dy-1) ) then | |
903 | SetD ay(dy-1); | |
904 | end; | |
905 | end; | |
906 | ||
907 | function T ORDateComb o.InitMont hs(GetSize : boolean) : integer; | |
908 | var | |
909 | i, Size: integer; | |
910 | ||
911 | begin | |
912 | Result : = 0; | |
913 | if(assig ned(FMonth Combo)) th en | |
914 | begin | |
915 | FMonth Combo.Item s.Clear; | |
916 | FMonth Combo.Item s.Add(' ') ; | |
917 | for i := 1 to 12 do | |
918 | begin | |
919 | if F LongMonths then | |
920 | FM onthCombo. Items.Add( FormatSett ings.LongM onthNames[ i]) // 2FA | |
921 | else | |
922 | FM onthCombo. Items.Add( FormatSett ings.Short MonthNames [i]); // 2 FA | |
923 | if(G etSize) th en | |
924 | begi n | |
925 | Si ze := Text WidthByFon t(Font.Han dle, FMont hCombo.Ite ms[i]); | |
926 | if (Result < Size) then | |
927 | Result := Size; | |
928 | end; | |
929 | end; | |
930 | if(Get Size) then | |
931 | inc( Result, Co mboBoxAdjS ize); | |
932 | end; | |
933 | end; | |
934 | ||
935 | procedure TORDateCom bo.Rebuild ; | |
936 | var | |
937 | Wide, X, Y: intege r; | |
938 | ||
939 | begin | |
940 | if(not F Rebuilding ) then | |
941 | begin | |
942 | FRebui lding := T RUE; | |
943 | try | |
944 | Cont rolStyle : = ControlS tyle + [cs AcceptsCon trols]; | |
945 | try | |
946 | Y := TextHei ghtByFont( Font.Handl e, FontHei ghtText); | |
947 | if not FTemp lateField then | |
948 | inc(Y,AdjV ertSize); | |
949 | X := 0; | |
950 | if (FIncludeM onth) then | |
951 | be gin | |
952 | if(not ass igned(FMon thCombo)) then | |
953 | begin | |
954 | FMonthCo mbo := TOR MonthCombo .Create(Se lf); | |
955 | FMonthCo mbo.Parent := Self; | |
956 | FMonthCo mbo.Top := 0; | |
957 | FMonthCo mbo.Left : = 0; | |
958 | FMonthCo mbo.Style := orcsDro pDown; | |
959 | FMonthCo mbo.DropDo wnCount := 13; | |
960 | FMonthCo mbo.ListIt emsOnly := True; | |
961 | FMonthCo mbo.OnChan ge := Mont hChanged; | |
962 | end; | |
963 | FMonthComb o.Font := Font; | |
964 | FMonthComb o.Template Field := F TemplateFi eld; | |
965 | Wide := In itMonths(T RUE); | |
966 | FMonthComb o.Width := Wide; | |
967 | FMonthComb o.Height : = Y; | |
968 | FMonthComb o.ItemInde x := FMont h; | |
969 | inc(X, Wid e + DateCo mboCtrlGap ); | |
970 | ||
971 | if(FInclud eDay) then | |
972 | begin | |
973 | if(not a ssigned(FD ayCombo)) then | |
974 | begin | |
975 | FDayCo mbo := TOR DayCombo.C reate(Self ); | |
976 | FDayCo mbo.Parent := Self; | |
977 | FDayCo mbo.Top := 0; | |
978 | FDayCo mbo.Style := orcsDro pDown; | |
979 | FDayCo mbo.ListIt emsOnly := True; | |
980 | FDayCo mbo.OnChan ge := DayC hanged; | |
981 | FDayCo mbo.DropDo wnCount := 11; | |
982 | end; | |
983 | FDayComb o.Font := Font; | |
984 | FDayComb o.Template Field := F TemplateFi eld; | |
985 | Wide := InitDays(T RUE); | |
986 | FDayComb o.Width := Wide; | |
987 | FDayComb o.Height : = Y; | |
988 | FDayComb o.Left := X; | |
989 | FDayComb o.ItemInde x := FDay; | |
990 | inc(X, W ide + Date ComboCtrlG ap); | |
991 | end | |
992 | else | |
993 | KillObj( @FDayCombo ); | |
994 | en d | |
995 | el se | |
996 | be gin | |
997 | KillObj(@F DayCombo); | |
998 | KillObj(@F MonthCombo ); | |
999 | en d; | |
1000 | if (not assig ned(FYearE dit)) then | |
1001 | be gin | |
1002 | FYearEdit := FORYear EditClass. Create(Sel f); | |
1003 | FYearEdit. Parent := Self; | |
1004 | FYearEdit. Top := 0; | |
1005 | FYearEdit. EditMask : = '9999;1; '; | |
1006 | FYearEdit. OnKeyPress := YearKe yPress; | |
1007 | FYearEdit. OnChange : = YearChan ged; | |
1008 | en d; | |
1009 | FY earEdit.Fo nt := Font ; | |
1010 | FY earEdit.Te mplateFiel d := FTemp lateField; | |
1011 | Wi de := GetY earSize; | |
1012 | FY earEdit.Wi dth := Wid e; | |
1013 | FY earEdit.He ight := Y; | |
1014 | FY earEdit.Le ft := X; | |
1015 | in c(X, Wide) ; | |
1016 | if (not assig ned(FYearU D)) then | |
1017 | be gin | |
1018 | FYearUD := TUpDown.C reate(Self ); | |
1019 | FYearUD.Pa rent := Se lf; | |
1020 | FYearUD.Th ousands := FALSE; | |
1021 | FYearUD.Mi n := First Year-1; | |
1022 | FYearUD.Ma x := LastY ear; | |
1023 | FYearUD.On ChangingEx := YearUD Change; | |
1024 | en d; | |
1025 | FY earEdit.Ta bOrder := 0; | |
1026 | FY earUD.Top := 0; | |
1027 | FY earUD.Left := X; | |
1028 | FY earUD.Heig ht := Y; | |
1029 | FY earUD.Posi tion := FY ear; | |
1030 | in c(X, FYear UD.Width + DateCombo CtrlGap); | |
1031 | if (FIncludeB tn) then | |
1032 | be gin | |
1033 | if(not ass igned(FCal Btn)) then | |
1034 | begin | |
1035 | FCalBtn := TORDate Button.Cre ate(Self); | |
1036 | FCalBtn. TabStop := FALSE; | |
1037 | FCalBtn. Parent := Self; | |
1038 | FCalBtn. Top := 0; | |
1039 | LoadElli psis(FCalB tn.Glyph, FBlackColo rMode); | |
1040 | FCalBtn. OnClick := BtnClicke d; | |
1041 | end; | |
1042 | Wide := FY earEdit.He ight; | |
1043 | if(Wide > Y) then Wi de := Y; | |
1044 | FCalBtn.Wi dth := Wid e; | |
1045 | FCalBtn.He ight := Wi de; | |
1046 | FCalBtn.Le ft := X; | |
1047 | inc(X, Wid e + DateCo mboCtrlGap ); | |
1048 | en d | |
1049 | el se | |
1050 | KillObj(@F CalBtn); | |
1051 | Se lf.Width : = X - Date ComboCtrlG ap; | |
1052 | Se lf.Height := Y; | |
1053 | Ch eckDays; | |
1054 | FC trlsCreate d := TRUE; | |
1055 | Do Change; | |
1056 | fina lly | |
1057 | Co ntrolStyle := Contro lStyle - [ csAcceptsC ontrols]; | |
1058 | end; | |
1059 | finall y | |
1060 | FReb uilding := FALSE; | |
1061 | end; | |
1062 | end; | |
1063 | end; | |
1064 | ||
1065 | procedure TORDateCom bo.SetBlac kColorMode (Value: bo olean); | |
1066 | begin | |
1067 | if FBlac kColorMode <> Value then | |
1068 | begin | |
1069 | FBlack ColorMode := Value; | |
1070 | if ass igned(FCal Btn) then | |
1071 | Load Ellipsis(F CalBtn.Gly ph, FBlack ColorMode) ; | |
1072 | end; | |
1073 | end; | |
1074 | ||
1075 | procedure TORDateCom bo.SetDay( Value: int eger); | |
1076 | begin | |
1077 | if(not a ssigned(FD ayCombo)) and (not ( csLoading in Compone ntState)) then | |
1078 | Value := 0; | |
1079 | if(Value > DaysPer Month(FYea r, FMonth) ) then | |
1080 | Value := 0; | |
1081 | if(FDay <> Value) then | |
1082 | begin | |
1083 | FDay : = Value; | |
1084 | if(ass igned(FDay Combo)) th en | |
1085 | begin | |
1086 | if(F DayCombo.I tems.Count <= FDay) then | |
1087 | In itDays(FAL SE); | |
1088 | FDay Combo.Item Index := F Day; | |
1089 | end; | |
1090 | DoChan ge; | |
1091 | end; | |
1092 | end; | |
1093 | ||
1094 | procedure TORDateCom bo.SetIncl udeBtn(con st Value: boolean); | |
1095 | begin | |
1096 | if(FIncl udeBtn <> Value) the n | |
1097 | begin | |
1098 | FInclu deBtn := V alue; | |
1099 | Rebuil d; | |
1100 | end; | |
1101 | end; | |
1102 | ||
1103 | procedure TORDateCom bo.SetIncl udeDay(Val ue: boolea n); | |
1104 | begin | |
1105 | if(Value ) and (not FIncludeM onth) then | |
1106 | Value := FALSE; | |
1107 | if(FIncl udeDay <> Value) the n | |
1108 | begin | |
1109 | FInclu deDay := V alue; | |
1110 | if(not Value) th en FDay := 0; | |
1111 | Rebuil d; | |
1112 | end; | |
1113 | end; | |
1114 | ||
1115 | procedure TORDateCom bo.SetIncl udeMonth(c onst Value : boolean) ; | |
1116 | begin | |
1117 | if(FIncl udeMonth < > Value) t hen | |
1118 | begin | |
1119 | FInclu deMonth := Value; | |
1120 | if(not Value) th en | |
1121 | begin | |
1122 | FInc ludeDay := FALSE; | |
1123 | FMon th := 0; | |
1124 | FDay := 0; | |
1125 | end; | |
1126 | Rebuil d; | |
1127 | end; | |
1128 | end; | |
1129 | ||
1130 | procedure TORDateCom bo.SetMont h(Value: i nteger); | |
1131 | begin | |
1132 | if(not a ssigned(FM onthCombo) ) and (not (csLoadin g in Compo nentState) ) then | |
1133 | Value := 0; | |
1134 | if(Value <0) or (V alue > 12) then | |
1135 | Value := 0; | |
1136 | if(FMont h <> Value ) then | |
1137 | begin | |
1138 | FMonth := Value; | |
1139 | if(ass igned(FMon thCombo)) then | |
1140 | FMon thCombo.It emIndex := FMonth; | |
1141 | CheckD ays; | |
1142 | DoChan ge; | |
1143 | end; | |
1144 | end; | |
1145 | ||
1146 | procedure TORDateCom bo.SetLong Months(con st Value: boolean); | |
1147 | begin | |
1148 | if(FLong Months <> Value) the n | |
1149 | begin | |
1150 | FLongM onths := V alue; | |
1151 | Rebuil d; | |
1152 | end; | |
1153 | end; | |
1154 | ||
1155 | procedure TORDateCom bo.SetYear (const Val ue: intege r); | |
1156 | begin | |
1157 | if(FYear <> Value) then | |
1158 | begin | |
1159 | FYear := Value; | |
1160 | if(FYe ar < First Year) or ( FYear > La stYear) th en | |
1161 | FYea r := 0; | |
1162 | if(not FYearChan ging) and (assigned( FYearEdit) ) and (ass igned(FYea rUD)) then | |
1163 | begin | |
1164 | FYea rChanging := TRUE; | |
1165 | try | |
1166 | if (FYear = 0 ) then | |
1167 | be gin | |
1168 | FYearEdit. Text := ' '; | |
1169 | FYearUD.Po sition := FirstYear- 1 | |
1170 | en d | |
1171 | el se | |
1172 | be gin | |
1173 | FYearEdit. Text := In tToStr(FYe ar); | |
1174 | FYearUD.Po sition := FYear; | |
1175 | en d; | |
1176 | fina lly | |
1177 | FY earChangin g := FALSE ; | |
1178 | end; | |
1179 | end; | |
1180 | if(FMo nth = 2) t hen | |
1181 | Init Days(FALSE ); | |
1182 | CheckD ays; | |
1183 | DoChan ge; | |
1184 | end; | |
1185 | end; | |
1186 | ||
1187 | procedure TORDateCom bo.DayChan ged(Sender : TObject) ; | |
1188 | begin | |
1189 | FDay := FDayCombo. ItemIndex; | |
1190 | if(FDay < 0) then | |
1191 | FDay : = 0; | |
1192 | CheckDay s; | |
1193 | DoChange ; | |
1194 | end; | |
1195 | ||
1196 | procedure TORDateCom bo.MonthCh anged(Send er: TObjec t); | |
1197 | begin | |
1198 | FMonth : = FMonthCo mbo.ItemIn dex; | |
1199 | if(FMont h < 0) the n | |
1200 | FMonth := 0; | |
1201 | InitDays (FALSE); | |
1202 | CheckDay s; | |
1203 | DoChange ; | |
1204 | end; | |
1205 | ||
1206 | procedure TORDateCom bo.YearCha nged(Sende r: TObject ); | |
1207 | begin | |
1208 | if FYear Changing t hen exit; | |
1209 | FYearCha nging := T RUE; | |
1210 | try | |
1211 | FYear := StrToIn tDef(FYear Edit.Text, 0); | |
1212 | if(FYe ar < First Year) or ( FYear > La stYear) th en | |
1213 | FYea r := 0; | |
1214 | if(FYe ar = 0) th en | |
1215 | FYea rUD.Positi on := Firs tYear-1 | |
1216 | else | |
1217 | FYea rUD.Positi on := FYea r; | |
1218 | if(FMo nth = 2) t hen | |
1219 | Init Days(FALSE ); | |
1220 | CheckD ays; | |
1221 | DoChan ge; | |
1222 | finally | |
1223 | FYearC hanging := FALSE; | |
1224 | end; | |
1225 | end; | |
1226 | ||
1227 | procedure TORDateCom bo.CheckDa ys; | |
1228 | var | |
1229 | MaxDays: integer; | |
1230 | ||
1231 | begin | |
1232 | if(FIncl udeMonth a nd assigne d(FMonthCo mbo)) then | |
1233 | begin | |
1234 | FMonth Combo.Enab led := (FY ear > 0); | |
1235 | if (FY ear = 0) t hen | |
1236 | SetM onth(0); | |
1237 | if(FIn cludeMonth and FIncl udeDay and assigned( FDayCombo) ) then | |
1238 | begin | |
1239 | FDay Combo.Enab led := ((F Year > 0) and (FMont h > 0)); | |
1240 | MaxD ays := Day sPerMonth( FYear, FMo nth); | |
1241 | if(F Day > MaxD ays) then | |
1242 | Se tDay(MaxDa ys); | |
1243 | end; | |
1244 | end; | |
1245 | end; | |
1246 | ||
1247 | procedure TORDateCom bo.Loaded; | |
1248 | begin | |
1249 | inherite d; | |
1250 | if(not F CtrlsCreat ed) then | |
1251 | Rebuil d; | |
1252 | end; | |
1253 | ||
1254 | procedure TORDateCom bo.Paint; | |
1255 | begin | |
1256 | if(not F CtrlsCreat ed) then | |
1257 | Rebuil d; | |
1258 | inherite d; | |
1259 | end; | |
1260 | ||
1261 | procedure TORDateCom bo.BtnClic ked(Sender : TObject) ; | |
1262 | var | |
1263 | mm, dd, yy: intege r; | |
1264 | m, d, y: word; | |
1265 | DateDial og: TORDat eTimeDlg; | |
1266 | ||
1267 | begin | |
1268 | DateDial og := TORD ateTimeDlg .Create(se lf); | |
1269 | try | |
1270 | mm := FMonth; | |
1271 | dd := FDay; | |
1272 | yy := FYear; | |
1273 | Decode Date(Now, y, m, d); | |
1274 | if(FYe ar = 0) th en FYear : = y; | |
1275 | if(FYe ar = y) th en | |
1276 | begin | |
1277 | if(( FMonth = 0 ) or (FMon th = m)) a nd (FDay = 0) then | |
1278 | begi n | |
1279 | FM onth := m; | |
1280 | FD ay := d; | |
1281 | end; | |
1282 | end; | |
1283 | if(FMo nth = 0) t hen | |
1284 | FMon th := 1; | |
1285 | if(FDa y = 0) the n | |
1286 | FDay := 1; | |
1287 | DateDi alog.FMDat eTime := G etFMDate; | |
1288 | DateDi alog.DateO nly := TRU E; | |
1289 | DateDi alog.Requi reTime := FALSE; | |
1290 | if Dat eDialog.Ex ecute then | |
1291 | begin | |
1292 | FYea r := 0; | |
1293 | FMon th := 0; | |
1294 | FDay := 0; | |
1295 | SetF MDate(Date Dialog.FMD ateTime); | |
1296 | end | |
1297 | else | |
1298 | begin | |
1299 | SetY ear(yy); | |
1300 | SetM onth(mm); | |
1301 | SetD ay(dd); | |
1302 | end; | |
1303 | finally | |
1304 | DateDi alog.Free; | |
1305 | end; | |
1306 | end; | |
1307 | ||
1308 | procedure TORDateCom bo.YearUDC hange(Send er: TObjec t; var All owChange: Boolean; | |
1309 | // 2FA NewValue : Smallint ; Directio n: TUpDown Direction) ; | |
1310 | NewV alue: Inte ger; Direc tion: TUpD ownDirecti on); | |
1311 | var | |
1312 | y, m, d: word; | |
1313 | ||
1314 | begin | |
1315 | if FYear Changing t hen exit; | |
1316 | FYearCha nging := T RUE; | |
1317 | try | |
1318 | if FYe arUD.Posit ion = (Fir stYear-1) then | |
1319 | begin | |
1320 | Deco deDate(Now , y, m, d) ; | |
1321 | FYea r := y; | |
1322 | FYea rUD.Positi on := y; | |
1323 | Allo wChange := FALSE; | |
1324 | end | |
1325 | else | |
1326 | FYea r := NewVa lue; | |
1327 | if(FYe ar < First Year) or ( FYear > La stYear) th en | |
1328 | FYea r := 0; | |
1329 | if(FYe ar = 0) th en | |
1330 | FYea rEdit.Text := ' ' | |
1331 | else | |
1332 | FYea rEdit.Text := IntToS tr(FYear); | |
1333 | if(FMo nth = 2) t hen | |
1334 | Init Days(FALSE ); | |
1335 | CheckD ays; | |
1336 | DoChan ge; | |
1337 | finally | |
1338 | FYearC hanging := FALSE; | |
1339 | end; | |
1340 | end; | |
1341 | ||
1342 | procedure TORDateCom bo.YearKey Press(Send er: TObjec t; var Key : Char); | |
1343 | begin | |
1344 | if(Key i n ['0'..'9 ']) and (F YearEdit.T ext = ' ') then | |
1345 | begin | |
1346 | FYearE dit.Text : = Key + ' '; | |
1347 | Key := #0; | |
1348 | FYearE dit.SelSta rt := 1; | |
1349 | FYearE dit.SelTex t := ''; | |
1350 | end; | |
1351 | end; | |
1352 | ||
1353 | function T ORDateComb o.GetFMDat e: TFMDate Time; | |
1354 | begin | |
1355 | if(FYear < FirstYe ar) then | |
1356 | Result := 0 | |
1357 | else | |
1358 | Result := ((FYea r - 1700) * 10000 + FMonth * 1 00 + FDay) ; | |
1359 | end; | |
1360 | ||
1361 | procedure TORDateCom bo.SetFMDa te(const V alue: TFMD ateTime); | |
1362 | var | |
1363 | ival, mo , dy: inte ger; | |
1364 | ||
1365 | begin | |
1366 | if(Value = 0) then | |
1367 | begin | |
1368 | SetYea r(0); | |
1369 | SetMon th(0); | |
1370 | end | |
1371 | else | |
1372 | begin | |
1373 | ival : = trunc(Va lue); | |
1374 | if(len gth(inttos tr(ival)) <> 7) then | |
1375 | exit ; | |
1376 | dy := (ival mod 100); | |
1377 | ival : = ival div 100; | |
1378 | mo := ival mod 1 00; | |
1379 | ival : = ival div 100; | |
1380 | SetYea r(ival + 1 700); | |
1381 | SetMon th(mo); | |
1382 | InitDa ys(FALSE); | |
1383 | SetDay (dy); | |
1384 | end; | |
1385 | end; | |
1386 | ||
1387 | function T ORDateComb o.DateText : string; | |
1388 | begin | |
1389 | Result : = ''; | |
1390 | if(FYear > 0) then | |
1391 | begin | |
1392 | if(FMo nth > 0) t hen | |
1393 | begin | |
1394 | if F LongMonths then | |
1395 | Re sult := Fo rmatSettin gs.LongMon thNames[FM onth] //2F A | |
1396 | else | |
1397 | Re sult := Fo rmatSettin gs.ShortMo nthNames[F Month]; // 2FA | |
1398 | if(F Day > 0) t hen | |
1399 | Re sult := Re sult + ' ' + IntToSt r(FDay); | |
1400 | Resu lt := Resu lt + ', '; | |
1401 | end; | |
1402 | Result := Result + IntToSt r(FYear); | |
1403 | end; | |
1404 | end; | |
1405 | ||
1406 | procedure TORDateCom bo.DoChang e; | |
1407 | begin | |
1408 | if assig ned(FOnCha nge) then | |
1409 | FOnCha nge(Self); | |
1410 | end; | |
1411 | ||
1412 | procedure TORDateCom bo.Resized (Sender: T Object); | |
1413 | begin | |
1414 | Rebuild; | |
1415 | end; | |
1416 | ||
1417 | procedure TORDateCom bo.CMFontC hanged(var Message: TMessage); | |
1418 | begin | |
1419 | inherite d; | |
1420 | Rebuild; | |
1421 | end; | |
1422 | ||
1423 | function T ORDateComb o.Text: st ring; | |
1424 | var | |
1425 | tmp, fmt , m: strin g; | |
1426 | ||
1427 | begin | |
1428 | Result : = ''; | |
1429 | tmp := F loatToStr( FMDate); | |
1430 | if(tmp < > '') and (tmp <> '0 ') and (le ngth(Tmp) >= 7) then | |
1431 | begin | |
1432 | if FLo ngMonths t hen | |
1433 | m := 'mmmm' | |
1434 | else | |
1435 | m := 'mmm'; | |
1436 | if(cop y(tmp,4,4) = '0000') then | |
1437 | fmt := 'yyyy' | |
1438 | else | |
1439 | if(cop y(tmp,6,2) = '00') t hen | |
1440 | fmt := m + ', YYYY' | |
1441 | else | |
1442 | fmt := m + ' D , YYYY'; | |
1443 | Result := Format FMDateTime Str(fmt, t mp) | |
1444 | end; | |
1445 | end; | |
1446 | ||
1447 | ||
1448 | procedure Register; | |
1449 | { used by Delphi to put compon ents on th e Palette } | |
1450 | begin | |
1451 | Register Components ('CPRS', [ TORDateTim eDlg, TORD ateBox, TO RDateCombo ]); | |
1452 | end; | |
1453 | ||
1454 | procedure TORDateCom bo.SetTemp lateField( const Valu e: boolean ); | |
1455 | begin | |
1456 | if FTemp lateField <> Value t hen | |
1457 | begin | |
1458 | FTempl ateField : = Value; | |
1459 | Rebuil d; | |
1460 | end; | |
1461 | end; | |
1462 | ||
1463 | initializa tion | |
1464 | uServerT oday := 0; | |
1465 | ||
1466 | end. |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.