Produced by Araxis Merge on 3/31/2017 10:45:36 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 | CPRS v31A.zip\CPRS v31A\OR_30_434V106_SRC.zip\Templates | uTemplateFields.pas | Tue Sep 13 13:32:24 2016 UTC |
2 | CPRS v31A.zip\CPRS v31A\OR_30_434V106_SRC.zip\Templates | uTemplateFields.pas | Fri Mar 31 14:53:37 2017 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 6 | 5136 |
Changed | 5 | 10 |
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 uTemp lateFields ; | |
2 | ||
3 | interface | |
4 | ||
5 | uses | |
6 | Forms, S ysUtils, C lasses, Di alogs, Std Ctrls, Ext Ctrls, Con trols, Con tnrs, | |
7 | Graphics , ORClasse s, ComCtrl s, ORDtTm, uDlgCompo nents, Typ Info, ORFn , StrUtils ; | |
8 | ||
9 | type | |
10 | TTemplat eFieldType = (dftUnk nown, dftE ditBox, df tComboBox, dftButton , dftCheck Boxes, | |
11 | dftRad ioButtons, dftDate, dftNumber, dftHyperl ink, dftWP , dftText, | |
12 | // keep df tScreenRea der as las t entry - users can not create this type of field | |
13 | dftScr eenReader) ; | |
14 | ||
15 | TTmplFld DateType = (dtUnknow n, dtDate, dtDateTim e, dtDateR eqTime, | |
16 | dtCombo , dtYear, dtYearMont h); | |
17 | ||
18 | const | |
19 | FldItemT ypes = [d ftComboBox , dftButto n, dftChec kBoxes, df tRadioButt ons, dftWP , dftText] ; | |
20 | SepLines Types = [d ftCheckBox es, dftRad ioButtons] ; | |
21 | EditLenT ypes = [d ftEditBox, dftComboB ox, dftWP] ; | |
22 | EditDflt Types = [d ftEditBox, dftHyperl ink]; | |
23 | EditDflt Type2 = [d ftEditBox, dftHyperl ink, dftDa te]; | |
24 | ItemDflt Types = [d ftComboBox , dftButto n, dftChec kBoxes, df tRadioButt ons]; | |
25 | NoRequir ed = [d ftHyperlin k, dftText ]; | |
26 | ExcludeT ext = [d ftHyperlin k, dftText ]; | |
27 | DateComb oTypes = [ dtCombo, d tYear, dtY earMonth]; | |
28 | ||
29 | type | |
30 | TTemplat eDialogEnt ry = class (TObject) | |
31 | private | |
32 | FID: s tring; | |
33 | FFont: TFont; | |
34 | FPanel : TDlgFiel dPanel; | |
35 | FContr ols: TStri ngList; | |
36 | FInden ts: TStrin gList; | |
37 | FFirst Build: boo lean; | |
38 | FOnCha nge: TNoti fyEvent; | |
39 | FText: string; | |
40 | FInter nalID: str ing; | |
41 | FObj: TObject; | |
42 | FField Values: st ring; | |
43 | FUpdat ing: boole an; | |
44 | FAutoD estroyOnPa nelFree: b oolean; | |
45 | FPanel Dying: boo lean; | |
46 | FOnDes troy: TNot ifyEvent; | |
47 | proced ure KillLa bels; | |
48 | functi on GetFiel dValues: s tring; | |
49 | proced ure SetFie ldValues(c onst Value : string); | |
50 | proced ure SetAut oDestroyOn PanelFree( const Valu e: boolean ); | |
51 | functi on StripCo de(var txt : string; code: char ): boolean ; | |
52 | protecte d | |
53 | proced ure UpDown Change(Sen der: TObje ct); | |
54 | proced ure DoChan ge(Sender: TObject); | |
55 | functi on GetCont rolText(Ct rlID: inte ger; NoCom mas: boole an; | |
56 | va r FoundEnt ry: boolea n; AutoWra p: boolean ; | |
57 | em Field: str ing = ''): string; | |
58 | proced ure SetCon trolText(C trlID: int eger; ATex t: string) ; | |
59 | public | |
60 | constr uctor Crea te(AParent : TWinCont rol; AID, Text: stri ng); | |
61 | destru ctor Destr oy; overri de; | |
62 | functi on GetPane l(MaxLen: integer; A Parent: TW inControl; | |
63 | OwningCh eckBox: TC PRSDialogP arentCheck Box): TDlg FieldPanel ; | |
64 | functi on GetText : string; | |
65 | proper ty Text: s tring read FText wri te FText; | |
66 | proper ty Interna lID: strin g read FIn ternalID w rite FInte rnalID; | |
67 | proper ty ID: str ing read F ID; | |
68 | proper ty Obj: TO bject read FObj writ e FObj; | |
69 | proper ty OnChang e: TNotify Event read FOnChange write FOn Change; | |
70 | proper ty OnDestr oy: TNotif yEvent rea d FOnDestr oy write F OnDestroy; | |
71 | proper ty FieldVa lues: stri ng read Ge tFieldValu es write S etFieldVal ues; | |
72 | proper ty AutoDes troyOnPane lFree: boo lean read FAutoDestr oyOnPanelF ree | |
73 | write SetAutoDe stroyOnPan elFree; | |
74 | end; | |
75 | ||
76 | TTemplat eField = c lass(TObje ct) | |
77 | private | |
78 | FMaxLe n: integer ; | |
79 | FFldNa me: string ; | |
80 | FNameC hanged: bo olean; | |
81 | FLMTex t: string; | |
82 | FEditD efault: st ring; | |
83 | FNotes : string; | |
84 | FItems : string; | |
85 | FInact ive: boole an; | |
86 | FItemD efault: st ring; | |
87 | FFldTy pe: TTempl ateFieldTy pe; | |
88 | FRequi red: boole an; | |
89 | FSepLi nes: boole an; | |
90 | FTextL en: intege r; | |
91 | FInden t: integer ; | |
92 | FPad: integer; | |
93 | FMinVa l: integer ; | |
94 | FMaxVa l: integer ; | |
95 | FIncre ment: inte ger; | |
96 | FURL: string; | |
97 | FDateT ype: TTmpl FldDateTyp e; | |
98 | FModif ied: boole an; | |
99 | FID: s tring; | |
100 | FLocke d: boolean ; | |
101 | proced ure SetEdi tDefault(c onst Value : string); | |
102 | proced ure SetFld Name(const Value: st ring); | |
103 | proced ure SetFld Type(const Value: TT emplateFie ldType); | |
104 | proced ure SetIna ctive(cons t Value: b oolean); | |
105 | proced ure SetReq uired(cons t Value: b oolean); | |
106 | proced ure SetSep Lines(cons t Value: b oolean); | |
107 | proced ure SetIte mDefault(c onst Value : string); | |
108 | proced ure SetIte ms(const V alue: stri ng); | |
109 | proced ure SetLMT ext(const Value: str ing); | |
110 | proced ure SetMax Len(const Value: int eger); | |
111 | proced ure SetNot es(const V alue: stri ng); | |
112 | proced ure SetID( const Valu e: string) ; | |
113 | proced ure SetInc rement(con st Value: integer); | |
114 | proced ure SetInd ent(const Value: int eger); | |
115 | proced ure SetMax Val(const Value: int eger); | |
116 | proced ure SetMin Val(const Value: int eger); | |
117 | proced ure SetPad (const Val ue: intege r); | |
118 | proced ure SetTex tLen(const Value: in teger); | |
119 | proced ure SetURL (const Val ue: string ); | |
120 | functi on GetTemp lateFieldD efault: st ring; | |
121 | proced ure Create DialogCont rols(Entry : TTemplat eDialogEnt ry; | |
122 | var I ndex: Inte ger; CtrlI D: integer ); | |
123 | functi on SaveErr or: string ; | |
124 | functi on Width: integer; | |
125 | functi on GetRequ ired: bool ean; | |
126 | proced ure SetDat eType(cons t Value: T TmplFldDat eType); | |
127 | public | |
128 | constr uctor Crea te(AData: TStrings); | |
129 | destru ctor Destr oy; overri de; | |
130 | proced ure Assign (AFld: TTe mplateFiel d); | |
131 | functi on NewFiel d: boolean ; | |
132 | functi on CanModi fy: boolea n; | |
133 | proper ty ID: str ing read F ID write S etID; | |
134 | proper ty FldName : string r ead FFldNa me write S etFldName; | |
135 | proper ty NameCha nged: bool ean read F NameChange d; | |
136 | proper ty FldType : TTemplat eFieldType read FFld Type write SetFldTyp e; | |
137 | proper ty MaxLen: integer r ead FMaxLe n write Se tMaxLen; | |
138 | proper ty EditDef ault: stri ng read FE ditDefault write Set EditDefaul t; | |
139 | proper ty Items: string rea d FItems w rite SetIt ems; | |
140 | proper ty ItemDef ault: stri ng read FI temDefault write Set ItemDefaul t; | |
141 | proper ty LMText: string re ad FLMText write Set LMText; | |
142 | proper ty Inactiv e: boolean read FIna ctive writ e SetInact ive; | |
143 | proper ty Require d: boolean read GetR equired wr ite SetReq uired; | |
144 | proper ty SepLine s: boolean read FSep Lines writ e SetSepLi nes; | |
145 | proper ty TextLen : integer read FText Len write SetTextLen ; | |
146 | proper ty Indent: integer r ead FInden t write Se tIndent; | |
147 | proper ty Pad: in teger read FPad writ e SetPad; | |
148 | proper ty MinVal: integer r ead FMinVa l write Se tMinVal; | |
149 | proper ty MaxVal: integer r ead FMaxVa l write Se tMaxVal; | |
150 | proper ty Increme nt: intege r read FIn crement wr ite SetInc rement; | |
151 | proper ty URL: st ring read FURL write SetURL; | |
152 | proper ty DateTyp e: TTmplFl dDateType read FDate Type write SetDateTy pe; | |
153 | proper ty Notes: string rea d FNotes w rite SetNo tes; | |
154 | proper ty Templat eFieldDefa ult: strin g read Get TemplateFi eldDefault ; | |
155 | end; | |
156 | ||
157 | TIntStru c = class( TObject) | |
158 | public | |
159 | x: int eger; | |
160 | end; | |
161 | ||
162 | function G etDialogEn try(AParen t: TWinCon trol; AID, AText: st ring): TTe mplateDial ogEntry; | |
163 | procedure FreeEntrie s(SL: TStr ings); | |
164 | procedure AssignFiel dIDs(var T xt: string ); overloa d; | |
165 | procedure AssignFiel dIDs(SL: T Strings); overload; | |
166 | function R esolveTemp lateFields (Text: str ing; AutoW rap: boole an; Hidden : boolean = FALSE; I ncludeEmbe dded: bool ean = FALS E): string ; | |
167 | function A reTemplate FieldsRequ ired(const Text: str ing; FldVa lues: TORS tringList = nil): b oolean; | |
168 | function H asTemplate Field(txt: string): boolean; | |
169 | ||
170 | function G etTemplate Field(ATem plateField : string; ByIEN: boo lean): TTe mplateFiel d; | |
171 | function T emplateFie ldNameProb lem(Fld: T TemplateFi eld): bool ean; | |
172 | function S aveTemplat eFieldErro rs: string ; | |
173 | procedure ClearModif iedTemplat eFields; | |
174 | function A nyTemplate FieldsModi fied: bool ean; | |
175 | procedure ListTempla teFields(c onst AText : string; AList: TSt rings; Lis tErrors: b oolean = F ALSE); | |
176 | function B oilerplate TemplateFi eldsOK(con st AText: string; Ms g: string = ''): boo lean; | |
177 | procedure EnsureText (edt: TEdi t; ud: TUp Down); | |
178 | procedure ConvertCod es2Text(sl : TStrings ; Short: b oolean); | |
179 | function S tripEmbedd ed(iItems: string): string; | |
180 | procedure StripScree nReaderCod es(var Tex t: string) ; overload ; | |
181 | procedure StripScree nReaderCod es(SL: TSt rings); ov erload; | |
182 | function H asScreenRe aderBreakC odes(SL: T Strings): boolean; | |
183 | ||
184 | const | |
185 | Template FieldSigna ture = '{F LD'; | |
186 | Template FieldBegin Signature = Template FieldSigna ture + ':' ; | |
187 | Template FieldEndSi gnature = '}'; | |
188 | ScreenRe aderCodeSi gnature = '{SR-'; | |
189 | ScreenRe aderCodeTy pe = ' Sc reen Reade r Code'; | |
190 | ScreenRe aderCodeCo unt = 2; | |
191 | ScreenRe aderShownC ount = 1; | |
192 | ScreenRe aderStopCo de = Scree nReaderCod eSignature + 'STOP' + Template FieldEndSi gnature; | |
193 | ScreenRe aderStopCo deLen = Le ngth(Scree nReaderSto pCode); | |
194 | ScreenRe aderStopCo deID = '-4 3'; | |
195 | ScreenRe aderStopNa me = 'SCRE EN READER STOP CODE **'; | |
196 | ScreenRe aderStopCo deLine = S creenReade rStopCodeI D + U + Sc reenReader StopName + U + Scree nReaderCod eType; | |
197 | ScreenRe aderContin ueCode = S creenReade rCodeSigna ture + 'CO NT' + Temp lateFieldE ndSignatur e; | |
198 | ScreenRe aderContin ueCodeLen = Length(S creenReade rContinueC ode); | |
199 | ScreenRe aderContin ueCodeOld = ScreenRe aderCodeSi gnature + 'CONTINUE' + Templat eFieldEndS ignature; | |
200 | ScreenRe aderContin ueCodeOldL en = Lengt h(ScreenRe aderContin ueCodeOld) ; | |
201 | ScreenRe aderContin ueCodeID = '-44'; | |
202 | ScreenRe aderContin ueCodeName = 'SCREEN READER CO NTINUE COD E ***'; | |
203 | ScreenRe aderContin ueCodeLine = ScreenR eaderConti nueCodeID + U + Scre enReaderCo ntinueCode Name + U + ScreenRea derCodeTyp e; | |
204 | MissingF ieldsTxt = 'One or m ore requir ed fields must still be entere d.'; | |
205 | ||
206 | ScreenRe aderCodes: array [0..Screen ReaderCode Count] of string = | |
207 | (Scr eenReaderS topCode, S creenReade rContinueC ode, Scree nReaderCon tinueCodeO ld); | |
208 | ScreenRe aderCodeLe ns: array [0..Screen ReaderCode Count] of integer = | |
209 | (Scr eenReaderS topCodeLen , ScreenRe aderContin ueCodeLen, ScreenRea derContinu eCodeOldLe n); | |
210 | ScreenRe aderCodeID s: array [0..Screen ReaderShow nCount] of string = | |
211 | (Scr eenReaderS topCodeID, ScreenRea derContinu eCodeID); | |
212 | ScreenRe aderCodeLi nes: array [0..Screen ReaderShow nCount] of string = | |
213 | (Scr eenReaderS topCodeLin e, ScreenR eaderConti nueCodeLin e); | |
214 | ||
215 | Template FieldTypeC odes: arra y[TTemplat eFieldType ] of strin g = | |
216 | { df tUnknown } ('', | |
217 | { df tEditBox } 'E' , | |
218 | { df tComboBox } 'C' , | |
219 | { df tButton } 'B' , | |
220 | { df tCheckBoxe s } 'X' , | |
221 | { df tRadioButt ons } 'R' , | |
222 | { df tDate } 'D' , | |
223 | { df tNumber } 'N' , | |
224 | { df tHyperlink } 'H' , | |
225 | { df tWP } 'W' , | |
226 | { df tText } 'T' , | |
227 | { df tScreenRea der } 'S' ); | |
228 | ||
229 | Template FieldTypeD esc: array [TTemplate FieldType, boolean] of string = | |
230 | { df tUnknown } (('' ,''), | |
231 | { df tEditBox } ('E dit Box', 'Edit'), | |
232 | { df tComboBox } ('C ombo Box', 'Combo'), | |
233 | { df tButton } ('B utton', 'Button'), | |
234 | { df tCheckBoxe s } ('C heck Boxes ', 'Check'), | |
235 | { df tRadioButt ons } ('R adio Butto ns', 'Radio'), | |
236 | { df tDate } ('D ate', 'Date'), | |
237 | { df tNumber } ('N umber', 'Num'), | |
238 | { df tHyperlink } ('H yperlink', 'Link'), | |
239 | { df tWP } ('W ord Proces sing', 'WP'), | |
240 | { df tText } ('D isplay Tex t', 'Text'), | |
241 | { df tScreenRea der } ('S creen Read er Stop', 'SRStop')) ; | |
242 | ||
243 | Template DateTypeDe sc: array[ TTmplFldDa teType, bo olean] of string = | |
244 | { dtU nknown } (('' ,''), | |
245 | { dtD ate } ('D ate', 'Dat e'), | |
246 | { dtD ateTime } ('D ate & Time ', 'Tim e'), | |
247 | { dtD ateReqTime } ('D ate & Req Time','R.T ime'), | |
248 | { dtC ombo } ('D ate Combo' , 'C.D ate'), | |
249 | { dtY ear } ('Y ear', 'Yea r'), | |
250 | { dtY earMonth } ('Y ear & Mont h', 'Mon th')); | |
251 | ||
252 | FldNames : array[TT emplateFie ldType] of string = | |
253 | { dftUnknow n } ('', | |
254 | { dftEditBo x } 'EDIT', | |
255 | { dftComboB ox } 'LIST', | |
256 | { dftButton } 'BTTN', | |
257 | { dftCheckB oxes } 'CBOX', | |
258 | { dftRadioB uttons } 'RBTN', | |
259 | { dftDate } 'DATE', | |
260 | { dftNumber } 'NUMB', | |
261 | { dftHyperl ink } 'LINK', | |
262 | { dftWP } 'WRDP', | |
263 | { dftTExt } 'TEXT', | |
264 | { dftScreen Reader } 'SRST'); | |
265 | ||
266 | Template FieldDateC odes: arra y[TTmplFld DateType] of string = | |
267 | { dtU nknown } ('', | |
268 | { dtD ate } 'D' , | |
269 | { dtD ateTime } 'T' , | |
270 | { dtD ateReqTime } 'R' , | |
271 | { dtC ombo } 'C' , | |
272 | { dtY ear } 'Y' , | |
273 | { dtY earMonth } 'M' ); | |
274 | ||
275 | MaxTFWPL ines = 20; | |
276 | MaxTFEdt Len = 70; | |
277 | ||
278 | implementa tion | |
279 | ||
280 | uses | |
281 | rTemplat es, ORCtrl s, mTempla teFieldBut ton, dShar ed, uConst , uCore, r Core, Wind ows, | |
282 | VAUtils, VA508Acce ssibilityM anager, VA 508Accessi bilityRout er, System .UITypes, System.Typ es; | |
283 | ||
284 | const | |
285 | NewTempl ateField = 'NEW TEMP LATE FIELD '; | |
286 | Template FieldSigna tureLen = length(Tem plateField BeginSigna ture); | |
287 | Template FieldSigna tureEndLen = length( TemplateFi eldEndSign ature); | |
288 | ||
289 | var | |
290 | uTmplFld s: TList = nil; | |
291 | uEntries : TStringL ist = nil; | |
292 | ||
293 | uNewTemp lateFieldI DCnt: long int = 0; | |
294 | uRadioGr oupIndex: integer = 0; | |
295 | ||
296 | uInterna lFieldIDCo unt: integ er = 0; | |
297 | ||
298 | const | |
299 | FieldIDD elim = '`' ; | |
300 | FieldIDL en = 6; | |
301 | NewLine = 'NL'; | |
302 | ||
303 | function G etNewField ID: string ; | |
304 | begin | |
305 | inc(uInt ernalField IDCount); | |
306 | Result : = IntToStr (uInternal FieldIDCou nt); | |
307 | Result : = FieldIDD elim + | |
308 | copy(Str ingOfChar( '0', Field IDLen-2) + Result, l ength(Resu lt), Field IDLen-1); | |
309 | end; | |
310 | ||
311 | function G etDialogEn try(AParen t: TWinCon trol; AID, AText: st ring): TTe mplateDial ogEntry; | |
312 | var | |
313 | idx: int eger; | |
314 | ||
315 | begin | |
316 | Result : = nil; | |
317 | if AID = '' then e xit; | |
318 | if(not a ssigned(uE ntries)) t hen | |
319 | uEntri es := TStr ingList.Cr eate; | |
320 | idx := u Entries.In dexOf(AID) ; | |
321 | if(idx < 0) then | |
322 | begin | |
323 | Result := TTempl ateDialogE ntry.Creat e(AParent, AID, ATex t); | |
324 | uEntri es.AddObje ct(AID, Re sult); | |
325 | end | |
326 | else | |
327 | Result := TTempl ateDialogE ntry(uEntr ies.Object s[idx]); | |
328 | end; | |
329 | ||
330 | procedure FreeEntrie s(SL: TStr ings); | |
331 | var | |
332 | i, idx, cnt: integ er; | |
333 | ||
334 | begin | |
335 | if(assig ned(uEntri es)) then | |
336 | begin | |
337 | for i := SL.Coun t-1 downto 0 do | |
338 | begin | |
339 | idx := uEntrie s.IndexOf( SL[i]); | |
340 | if(i dx >= 0) t hen | |
341 | begi n | |
342 | cn t := uEntr ies.Count; | |
343 | if (assigned( uEntries.O bjects[idx ])) then | |
344 | be gin | |
345 | TTemplateD ialogEntry (uEntries. Objects[id x]).AutoDe stroyOnPan elFree := FALSE; | |
346 | uEntries.O bjects[idx ].Free; | |
347 | en d; | |
348 | if cnt = uEn tries.Coun t then | |
349 | uEntries.D elete(idx) ; | |
350 | end; | |
351 | end; | |
352 | if(uEn tries.Coun t = 0) the n | |
353 | uInt ernalField IDCount := 0; | |
354 | end; | |
355 | end; | |
356 | ||
357 | procedure AssignFiel dIDs(var T xt: string ); | |
358 | var | |
359 | i: integ er; | |
360 | ||
361 | begin | |
362 | i := 0; | |
363 | while (i < length( Txt)) do | |
364 | begin | |
365 | inc(i) ; | |
366 | if(cop y(Txt,i,Te mplateFiel dSignature Len) = Tem plateField BeginSigna ture) then | |
367 | begin | |
368 | inc( i,Template FieldSigna tureLen); | |
369 | if(i < length( Txt)) and (copy(Txt, i,1) <> Fi eldIDDelim ) then | |
370 | begi n | |
371 | in sert(GetNe wFieldID, Txt, i); | |
372 | in c(i, Field IDLen); | |
373 | end; | |
374 | end; | |
375 | end; | |
376 | end; | |
377 | ||
378 | procedure AssignFiel dIDs(SL: T Strings); | |
379 | var | |
380 | i: integ er; | |
381 | txt: str ing; | |
382 | ||
383 | begin | |
384 | for i := 0 to SL.C ount-1 do | |
385 | begin | |
386 | txt := SL[i]; | |
387 | Assign FieldIDs(t xt); | |
388 | SL[i] := txt; | |
389 | end; | |
390 | end; | |
391 | ||
392 | procedure WordWrapTe xt(var Txt : string); | |
393 | var | |
394 | TmpSL: T StringList ; | |
395 | i: integ er; | |
396 | ||
397 | function WrappedTe xt(const S tr: string ): string; | |
398 | var | |
399 | i, i2, j, k: int eger; | |
400 | Temp: string; | |
401 | ||
402 | begin | |
403 | Temp : = Str; | |
404 | Result := ''; | |
405 | i2 := 0; | |
406 | ||
407 | repeat | |
408 | i := pos(Templ ateFieldBe ginSignatu re, Temp); | |
409 | ||
410 | if i >0 then | |
411 | j := pos(Tem plateField EndSignatu re, copy(T emp, i, Ma xInt)) | |
412 | else | |
413 | j := 0; | |
414 | ||
415 | if ( j > 0) the n | |
416 | be gin | |
417 | i2 := pos(Te mplateFiel dBeginSign ature, cop y(Temp, i+ TemplateFi eldSignatu reLen, Max Int)); | |
418 | if (i2 = 0) then | |
419 | i2 := MaxI nt | |
420 | el se | |
421 | i2 := i + TemplateFi eldSignatu reLen + i2 - 1; | |
422 | en d; | |
423 | ||
424 | if ( i>0) and ( j=0) then | |
425 | i := 0; | |
426 | ||
427 | if ( i>0) and ( j>0) then | |
428 | if (j > i2) then | |
429 | begin | |
430 | Result := Result + c opy(Temp, 1, i2-1); | |
431 | delete(Tem p, 1, i2-1 ); | |
432 | end | |
433 | el se | |
434 | begin | |
435 | for k := ( i+Template FieldSigna tureLen) t o (i+j-2) do | |
436 | if Temp[ k]=' ' the n | |
437 | Temp[k ]:= #1; | |
438 | i := i + j - 1; | |
439 | Result := Result + c opy(Temp,1 ,i); | |
440 | delete(Tem p,1,i); | |
441 | end; | |
442 | ||
443 | until (i = 0); | |
444 | ||
445 | Result := Result + Temp; | |
446 | Result := WrapTe xt(Result, #13#10, [ ' '], MAX_ ENTRY_WIDT H); | |
447 | repeat | |
448 | i := pos(#1, R esult); | |
449 | if i > 0 then | |
450 | Re sult[i] := ' '; | |
451 | until i = 0; | |
452 | end; | |
453 | ||
454 | begin | |
455 | if lengt h(Txt) > M AX_ENTRY_W IDTH then | |
456 | begin | |
457 | TmpSL := TString List.Creat e; | |
458 | try | |
459 | TmpS L.Text := Txt; | |
460 | Txt := ''; | |
461 | for i := 0 to TmpSL.Coun t-1 do | |
462 | begi n | |
463 | if Txt <> '' then | |
464 | Txt := Txt + CRLF; | |
465 | Tx t := Txt + WrappedTe xt(TmpSL[i ]); | |
466 | end; | |
467 | finall y | |
468 | TmpS L.Free; | |
469 | end; | |
470 | end; | |
471 | end; | |
472 | ||
473 | function R esolveTemp lateFields (Text: str ing; | |
474 | AutoWrap: boolean; | |
475 | Hidden: b oolean = F ALSE; | |
476 | IncludeEm bedded: bo olean = FA LSE): stri ng; | |
477 | var | |
478 | flen, Ct rlID, i, j : integer; | |
479 | Entry: T TemplateDi alogEntry; | |
480 | iField, Temp, NewT xt, Fld: s tring; | |
481 | FoundEnt ry: boolea n; | |
482 | TmplFld: TTemplate Field; | |
483 | ||
484 | procedur e AddNewTx t; | |
485 | begin | |
486 | if(New Txt <> '') then | |
487 | begin | |
488 | inse rt(StringO fChar('x', length(New Txt)), Tem p, i); | |
489 | inse rt(NewTxt, Result, i ); | |
490 | inc( i, length( NewTxt)); | |
491 | end; | |
492 | end; | |
493 | ||
494 | begin | |
495 | if(not a ssigned(uE ntries)) t hen | |
496 | uEntri es := TStr ingList.Cr eate; | |
497 | Result : = Text; | |
498 | Temp := Text; // U se Temp to allow tem plate fiel ds to cont ain other template f ield refer ences | |
499 | repeat | |
500 | i := p os(Templat eFieldBegi nSignature , Temp); | |
501 | if(i > 0) then | |
502 | begin | |
503 | Ctrl ID := 0; | |
504 | if(c opy(Temp, i + Templa teFieldSig natureLen, 1) = Fiel dIDDelim) then | |
505 | begi n | |
506 | Ct rlID := St rToIntDef( copy(Temp, i + Templ ateFieldSi gnatureLen + 1, Fiel dIDLen-1), 0); | |
507 | de lete(Temp, i + Templa teFieldSig natureLen, FieldIDLe n); | |
508 | de lete(Resul t,i + Temp lateFieldS ignatureLe n, FieldID Len); | |
509 | end; | |
510 | j := pos(Templ ateFieldEn dSignature , copy(Tem p, i + Tem plateField SignatureL en, MaxInt )); | |
511 | Fld := ''; | |
512 | if(j > 0) then | |
513 | begi n | |
514 | in c(j, i + T emplateFie ldSignatur eLen - 1); | |
515 | fl en := j - i - Templa teFieldSig natureLen; | |
516 | Fl d := copy( Temp,i + T emplateFie ldSignatur eLen, flen ); | |
517 | de lete(Temp, i,flen + T emplateFie ldSignatur eLen + 1); | |
518 | de lete(Resul t,i,flen + TemplateF ieldSignat ureLen + 1 ); | |
519 | end | |
520 | else | |
521 | begi n | |
522 | de lete(Temp, i,Template FieldSigna tureLen); | |
523 | de lete(Resul t,i,Templa teFieldSig natureLen) ; | |
524 | end; | |
525 | if(C trlID > 0) then | |
526 | begi n | |
527 | Fo undEntry : = FALSE; | |
528 | fo r j := 0 t o uEntries .Count-1 d o | |
529 | be gin | |
530 | Entry := T TemplateDi alogEntry( uEntries.O bjects[j]) ; | |
531 | if(assigne d(Entry)) then | |
532 | begin | |
533 | if Inclu deEmbedded then | |
534 | iField := Fld | |
535 | else | |
536 | iField := ''; | |
537 | NewTxt : = Entry.Ge tControlTe xt(CtrlID, FALSE, Fo undEntry, AutoWrap, iField); | |
538 | TmplFld := GetTemp lateField( Fld, FALSE ); | |
539 | if (assi gned(TmplF ld)) and ( TmplFld.Da teType in DateComboT ypes) then {if this is a TORDa teBox} | |
540 | NewTx t := Piece (NewTxt,': ',1); {we o nly want t he first p iece of Ne wTxt} | |
541 | AddNewTx t; | |
542 | end; | |
543 | if FoundEn try then b reak; | |
544 | en d; | |
545 | if Hidden an d (not Fou ndEntry) a nd (Fld <> '') then | |
546 | be gin | |
547 | NewTxt := TemplateFi eldBeginSi gnature + Fld + Temp lateFieldE ndSignatur e; | |
548 | AddNewTxt; | |
549 | en d; | |
550 | end; | |
551 | end; | |
552 | until(i = 0); | |
553 | if not A utoWrap th en | |
554 | WordWr apText(Res ult); | |
555 | end; | |
556 | ||
557 | function A reTemplate FieldsRequ ired(const Text: str ing; FldVa lues: TORS tringList = nil): b oolean; | |
558 | var | |
559 | flen, Ct rlID, i, j : integer; | |
560 | Entry: T TemplateDi alogEntry; | |
561 | Fld: TTe mplateFiel d; | |
562 | Temp, Ne wTxt, FldN ame: strin g; | |
563 | FoundEnt ry: boolea n; | |
564 | ||
565 | begin | |
566 | if(not a ssigned(uE ntries)) t hen | |
567 | uEntri es := TStr ingList.Cr eate; | |
568 | Temp := Text; | |
569 | Result : = FALSE; | |
570 | repeat | |
571 | i := p os(Templat eFieldBegi nSignature , Temp); | |
572 | if(i > 0) then | |
573 | begin | |
574 | Ctrl ID := 0; | |
575 | if(c opy(Temp, i + Templa teFieldSig natureLen, 1) = Fiel dIDDelim) then | |
576 | begi n | |
577 | Ct rlID := St rToIntDef( copy(Temp, i + Templ ateFieldSi gnatureLen + 1, Fiel dIDLen-1), 0); | |
578 | de lete(Temp, i + Templa teFieldSig natureLen, FieldIDLe n); | |
579 | end; | |
580 | j := pos(Templ ateFieldEn dSignature , copy(Tem p, i + Tem plateField SignatureL en, MaxInt )); | |
581 | if(j > 0) then | |
582 | begi n | |
583 | in c(j, i + T emplateFie ldSignatur eLen - 1); | |
584 | fl en := j - i - Templa teFieldSig natureLen; | |
585 | Fl dName := c opy(Temp, i + Templa teFieldSig natureLen, flen); | |
586 | Fl d := GetTe mplateFiel d(FldName, FALSE); | |
587 | de lete(Temp, i,flen + T emplateFie ldSignatur eLen + 1); | |
588 | end | |
589 | else | |
590 | begi n | |
591 | de lete(Temp, i,Template FieldSigna tureLen); | |
592 | Fl d := nil; | |
593 | end; | |
594 | if(C trlID > 0) and (assi gned(Fld)) and (Fld. Required) then | |
595 | begi n | |
596 | Fo undEntry : = FALSE; | |
597 | fo r j := 0 t o uEntries .Count-1 d o | |
598 | be gin | |
599 | Entry := T TemplateDi alogEntry( uEntries.O bjects[j]) ; | |
600 | if(assigne d(Entry)) then | |
601 | begin | |
602 | NewTxt : = Entry.Ge tControlTe xt(CtrlID, TRUE, Fou ndEntry, F ALSE); | |
603 | if FoundEn try and (N ewTxt = '' ) then{(Tr im(NewTxt) = '') the n //CODE A DDED BACK IN - DN S BELLC} | |
604 | Result := TRUE; | |
605 | end; | |
606 | if FoundEn try then b reak; | |
607 | en d; | |
608 | if (not Foun dEntry) an d assigned (FldValues ) then | |
609 | be gin | |
610 | j := FldVa lues.Index OfPiece(In tToStr(Ctr lID)); | |
611 | if(j < 0) or (Piece( FldValues[ j],U,2) = '') then | |
612 | Result : = TRUE; | |
613 | en d; | |
614 | end; | |
615 | end; | |
616 | until((i = 0) or R esult); | |
617 | end; | |
618 | ||
619 | function H asTemplate Field(txt: string): boolean; | |
620 | begin | |
621 | Result : = (pos(Tem plateField BeginSigna ture, txt) > 0); | |
622 | end; | |
623 | ||
624 | function G etTemplate Field(ATem plateField : string; ByIEN: boo lean): TTe mplateFiel d; | |
625 | var | |
626 | i, idx: integer; | |
627 | AData: T Strings; | |
628 | ||
629 | begin | |
630 | Result : = nil; | |
631 | if(not a ssigned(uT mplFlds)) then | |
632 | uTmplF lds := TLi st.Create; | |
633 | idx := - 1; | |
634 | for i := 0 to uTmp lFlds.Coun t-1 do | |
635 | begin | |
636 | if(ByI EN) then | |
637 | begin | |
638 | if(T TemplateFi eld(uTmplF lds[i]).FI D = ATempl ateField) then | |
639 | begi n | |
640 | id x := i; | |
641 | br eak; | |
642 | end; | |
643 | end | |
644 | else | |
645 | begin | |
646 | if(T TemplateFi eld(uTmplF lds[i]).FF ldName = A TemplateFi eld) then | |
647 | begi n | |
648 | id x := i; | |
649 | br eak; | |
650 | end; | |
651 | end; | |
652 | end; | |
653 | if(idx < 0) then | |
654 | begin | |
655 | if(ByI EN) then | |
656 | ADat a := LoadT emplateFie ldByIEN(AT emplateFie ld) | |
657 | else | |
658 | ADat a := LoadT emplateFie ld(ATempla teField); | |
659 | if(ADa ta.Count > 1) then | |
660 | Resu lt := TTem plateField .Create(AD ata); | |
661 | end | |
662 | else | |
663 | Result := TTempl ateField(u TmplFlds[i dx]); | |
664 | end; | |
665 | ||
666 | function T emplateFie ldNameProb lem(Fld: T TemplateFi eld): bool ean; | |
667 | const | |
668 | DUPFLD = 'Field Na me is not unique'; | |
669 | ||
670 | var | |
671 | i: integ er; | |
672 | msg: str ing; | |
673 | ||
674 | begin | |
675 | msg := ' '; | |
676 | if(Fld.F ldName = N ewTemplate Field) the n | |
677 | msg := 'Field Na me can not be ' + Ne wTemplateF ield | |
678 | else | |
679 | if(lengt h(Fld.FldN ame) < 3) then | |
680 | msg := 'Field Na me must be at least three char acters in length' | |
681 | else | |
682 | if(not C harInSet(F ld.FldName [1], ['A'. .'Z','0'.. '9'])) the n | |
683 | msg := 'First Fi eld Name c haracter m ust be "A" - "Z", or "0" - "9" ' | |
684 | else | |
685 | if(assig ned(uTmplF lds)) then | |
686 | begin | |
687 | for i := 0 to uT mplFlds.Co unt-1 do | |
688 | begin | |
689 | if(F ld <> uTmp lFlds[i]) and | |
690 | (C ompareText (TTemplate Field(uTmp lFlds[i]). FFldName, Fld.FFldNa me) = 0) t hen | |
691 | begi n | |
692 | ms g := DUPFL D; | |
693 | br eak; | |
694 | end; | |
695 | end; | |
696 | end; | |
697 | if(msg = '') and ( not IsTemp lateFieldN ameUnique( Fld.FFldNa me, Fld.ID )) then | |
698 | msg := DUPFLD; | |
699 | Result : = (msg <> ''); | |
700 | if(Resul t) then | |
701 | ShowMs g(msg); | |
702 | end; | |
703 | ||
704 | function S aveTemplat eFieldErro rs: string ; | |
705 | var | |
706 | i: integ er; | |
707 | Errors: TStringLis t; | |
708 | Fld: TTe mplateFiel d; | |
709 | msg: str ing; | |
710 | ||
711 | begin | |
712 | Result : = ''; | |
713 | if(assig ned(uTmplF lds)) then | |
714 | begin | |
715 | Errors := nil; | |
716 | try | |
717 | for i := 0 to uTmplFlds. Count-1 do | |
718 | begi n | |
719 | Fl d := TTemp lateField( uTmplFlds[ i]); | |
720 | if (Fld.FModi fied) then | |
721 | be gin | |
722 | msg := Fld .SaveError ; | |
723 | if(msg <> '') then | |
724 | begin | |
725 | if(not a ssigned(Er rors)) the n | |
726 | begin | |
727 | Errors := TStrin gList.Crea te; | |
728 | Errors .Add('The following template f ield save errors hav e occurred :'); | |
729 | Errors .Add(''); | |
730 | end; | |
731 | Errors.A dd(' ' + Fld.FldNam e + ': ' + msg); | |
732 | end; | |
733 | en d; | |
734 | end; | |
735 | finall y | |
736 | if(a ssigned(Er rors)) the n | |
737 | begi n | |
738 | Re sult := Er rors.Text; | |
739 | Er rors.Free; | |
740 | end; | |
741 | end; | |
742 | end; | |
743 | end; | |
744 | ||
745 | procedure ClearModif iedTemplat eFields; | |
746 | var | |
747 | i: integ er; | |
748 | Fld: TTe mplateFiel d; | |
749 | ||
750 | begin | |
751 | if(assig ned(uTmplF lds)) then | |
752 | begin | |
753 | for i := uTmplFl ds.Count-1 downto 0 do | |
754 | begin | |
755 | Fld := TTempla teField(uT mplFlds[i] ); | |
756 | if(a ssigned(Fl d)) and (F ld.FModifi ed) then | |
757 | begi n | |
758 | if Fld.FLock ed then | |
759 | UnlockTemp lateField( Fld.FID); | |
760 | Fl d.Free; | |
761 | end; | |
762 | end; | |
763 | end; | |
764 | end; | |
765 | ||
766 | function A nyTemplate FieldsModi fied: bool ean; | |
767 | var | |
768 | i: integ er; | |
769 | ||
770 | begin | |
771 | Result : = FALSE; | |
772 | if(assig ned(uTmplF lds)) then | |
773 | begin | |
774 | for i := 0 to uT mplFlds.Co unt-1 do | |
775 | begin | |
776 | if(T TemplateFi eld(uTmplF lds[i]).FM odified) t hen | |
777 | begi n | |
778 | Re sult := TR UE; | |
779 | br eak; | |
780 | end; | |
781 | end; | |
782 | end; | |
783 | end; | |
784 | ||
785 | procedure ListTempla teFields(c onst AText : string; AList: TSt rings; Lis tErrors: b oolean = F ALSE); | |
786 | var | |
787 | i, j, k, flen, Bad Count: int eger; | |
788 | flddesc, tmp, fld: string; | |
789 | TmpList: TStringLi st; | |
790 | Inactive List: TStr ingList; | |
791 | FldObj: TTemplateF ield; | |
792 | ||
793 | begin | |
794 | if(AText = '') the n exit; | |
795 | BadCount := 0; | |
796 | Inactive List := TS tringList. Create; | |
797 | try | |
798 | TmpLis t := TStri ngList.Cre ate; | |
799 | try | |
800 | TmpL ist.Text : = AText; | |
801 | for k := 0 to TmpList.Co unt-1 do | |
802 | begi n | |
803 | tm p := TmpLi st[k]; | |
804 | re peat | |
805 | i := pos(T emplateFie ldBeginSig nature, tm p); | |
806 | if(i > 0) then | |
807 | begin | |
808 | fld := ' '; | |
809 | j := pos (TemplateF ieldEndSig nature, co py(tmp, i + Template FieldSigna tureLen, M axInt)); | |
810 | if(j > 0 ) then | |
811 | begin | |
812 | inc(j, i + Templ ateFieldSi gnatureLen - 1); | |
813 | flen : = j - i - TemplateFi eldSignatu reLen; | |
814 | fld := copy(tmp, i + Templa teFieldSig natureLen, flen); | |
815 | delete (tmp, i, f len + Temp lateFieldS ignatureLe n + 1); | |
816 | end | |
817 | else | |
818 | begin | |
819 | delete (tmp,i,Tem plateField SignatureL en); | |
820 | inc(Ba dCount); | |
821 | end; | |
822 | if(fld < > '') then | |
823 | begin | |
824 | if Lis tErrors th en | |
825 | begin | |
826 | FldO bj := GetT emplateFie ld(fld, FA LSE); | |
827 | if a ssigned(Fl dObj) then | |
828 | begi n | |
829 | if FldObj.In active the n | |
830 | InactiveLi st.Add(' "' + fld + '"'); | |
831 | fl ddesc := ' '; | |
832 | end | |
833 | else | |
834 | fl ddesc := ' "' + fld + '"'; | |
835 | end | |
836 | else | |
837 | fldd esc := fld ; | |
838 | if(fld desc <> '' ) and (ALi st.IndexOf (flddesc) < 0) then | |
839 | ALis t.Add(fldd esc) | |
840 | end; | |
841 | end; | |
842 | un til (i = 0 ); | |
843 | end; | |
844 | finall y | |
845 | TmpL ist.Free; | |
846 | end; | |
847 | if Lis tErrors th en | |
848 | begin | |
849 | if(A List.Count > 0) then | |
850 | AL ist.Insert (0, 'The f ollowing t emplate fi elds were not found: '); | |
851 | if ( BadCount > 0) then | |
852 | begi n | |
853 | if (BadCount = 1) then | |
854 | tmp := 'A template f ield marke r "' + Tem plateField BeginSigna ture + | |
855 | '" was found without a' | |
856 | el se | |
857 | tmp := Int ToStr(BadC ount) + ' template f ield marke rs "' + Te mplateFiel dBeginSign ature + | |
858 | '" were found without'; | |
859 | if (AList.Cou nt > 0) th en | |
860 | AList.Add( ''); | |
861 | AL ist.Add(tm p + ' matc hing "' + TemplateFi eldEndSign ature + '" '); | |
862 | end; | |
863 | if(I nactiveLis t.Count > 0) then | |
864 | begi n | |
865 | if (AList.Cou nt > 0) th en | |
866 | AList.Add( ''); | |
867 | AL ist.Add('T he followi ng inactiv e template fields we re found:' ); | |
868 | Fa stAddStrin gs(Inactiv eList, ALi st); | |
869 | end; | |
870 | if(A List.Count > 0) then | |
871 | begi n | |
872 | AL ist.Insert (0, 'Text contains t emplate fi eld errors :'); | |
873 | AL ist.Insert (1, ''); | |
874 | end; | |
875 | end; | |
876 | finally | |
877 | Inacti veList.Fre e; | |
878 | end; | |
879 | end; | |
880 | ||
881 | function B oilerplate TemplateFi eldsOK(con st AText: string; Ms g: string = ''): boo lean; | |
882 | var | |
883 | Errors: TStringLis t; | |
884 | btns: TM sgDlgButto ns; | |
885 | ||
886 | begin | |
887 | Result : = TRUE; | |
888 | Errors : = TStringL ist.Create ; | |
889 | try | |
890 | ListTe mplateFiel ds(AText, Errors, TR UE); | |
891 | if(Err ors.Count > 0) then | |
892 | begin | |
893 | if(M sg = 'OK') then | |
894 | bt ns := [mbO K] | |
895 | else | |
896 | begi n | |
897 | bt ns := [mbA bort, mbIg nore]; | |
898 | Er rors.Add(' '); | |
899 | if (Msg = '') then | |
900 | Msg := 'te xt inserti on'; | |
901 | Er rors.Add(' Do you wan t to Abort ' + Msg + ', or Ign ore the er ror and co ntinue?'); | |
902 | end; | |
903 | Resu lt := (Mes sageDlg(Er rors.Text, mtError, btns, 0) = mrIgnore) ; | |
904 | end; | |
905 | finally | |
906 | Errors .Free; | |
907 | end; | |
908 | end; | |
909 | ||
910 | procedure EnsureText (edt: TEdi t; ud: TUp Down); | |
911 | var | |
912 | v: integ er; | |
913 | s: strin g; | |
914 | ||
915 | begin | |
916 | if assig ned(ud.Ass ociate) th en | |
917 | begin | |
918 | v := S trToIntDef (edt.Text, ud.Positi on); | |
919 | if (v < ud.Min) or (v > ud .Max) then | |
920 | v := ud.Positi on; | |
921 | s := I ntToStr(v) ; | |
922 | if edt .Text <> s then | |
923 | edt. Text := s; | |
924 | end; | |
925 | edt.SelS tart := ed t.GetTextL en; | |
926 | end; | |
927 | ||
928 | function T emplateFie ldCode2Fie ld(const C ode: strin g): TTempl ateFieldTy pe; | |
929 | var | |
930 | typ: TTe mplateFiel dType; | |
931 | ||
932 | begin | |
933 | Result : = dftUnkno wn; | |
934 | for typ := low(TTe mplateFiel dType) to high(TTemp lateFieldT ype) do | |
935 | if Cod e = Templa teFieldTyp eCodes[typ ] then | |
936 | begin | |
937 | Resu lt := typ; | |
938 | brea k; | |
939 | end; | |
940 | end; | |
941 | ||
942 | function T emplateDat eCode2Date Type(const Code: str ing): TTmp lFldDateTy pe; | |
943 | var | |
944 | typ: TTm plFldDateT ype; | |
945 | ||
946 | begin | |
947 | Result : = dtUnknow n; | |
948 | for typ := low(TTm plFldDateT ype) to hi gh(TTmplFl dDateType) do | |
949 | if Cod e = Templa teFieldDat eCodes[typ ] then | |
950 | begin | |
951 | Resu lt := typ; | |
952 | brea k; | |
953 | end; | |
954 | end; | |
955 | ||
956 | procedure ConvertCod es2Text(sl : TStrings ; Short: b oolean); | |
957 | var | |
958 | i: integ er; | |
959 | tmp, out put: strin g; | |
960 | ftype: T TemplateFi eldType; | |
961 | dtype: T TmplFldDat eType; | |
962 | ||
963 | begin | |
964 | for i := 0 to sl.C ount-1 do | |
965 | begin | |
966 | tmp := sl[i]; | |
967 | if pie ce(tmp,U,4 ) = BOOLCH AR[TRUE] t hen | |
968 | outp ut := '* ' | |
969 | else | |
970 | outp ut := ' ' ; | |
971 | ftype := Templat eFieldCode 2Field(Pie ce(tmp, U, 3)); | |
972 | if fty pe = dftDa te then | |
973 | begin | |
974 | dtyp e := Templ ateDateCod e2DateType (Piece(tmp , U, 5)); | |
975 | outp ut := outp ut + Templ ateDateTyp eDesc[dtyp e, short]; | |
976 | end | |
977 | else | |
978 | outp ut := outp ut + Templ ateFieldTy peDesc[fty pe, short] ; | |
979 | SetPie ce(tmp, U, 3, output ); | |
980 | sl[i] := tmp; | |
981 | end; | |
982 | end; | |
983 | ||
984 | { TTemplat eField } | |
985 | ||
986 | constructo r TTemplat eField.Cre ate(AData: TStrings) ; | |
987 | var | |
988 | tmp, p1: string; | |
989 | AFID, i, idx,cnt: i nteger; | |
990 | ||
991 | begin | |
992 | AFID := 0; | |
993 | if(assig ned(AData) ) then | |
994 | begin | |
995 | if ADa ta.Count > 0 then | |
996 | AFID := StrToI ntDef(ADat a[0],0); | |
997 | if(AFI D > 0) and (AData.Co unt > 1) t hen | |
998 | begin | |
999 | FID := IntToSt r(AFID); | |
1000 | FFld Name := Pi ece(AData[ 1],U,1); | |
1001 | FFld Type := Te mplateFiel dCode2Fiel d(Piece(AD ata[1],U,2 )); | |
1002 | FIna ctive := ( Piece(ADat a[1],U,3) = '1'); | |
1003 | FMax Len := Str ToIntDef(P iece(AData [1],U,4),0 ); | |
1004 | FEdi tDefault : = Piece(AD ata[1],U,5 ); | |
1005 | FLMT ext := Pie ce(AData[1 ],U,6); | |
1006 | idx := StrToIn tDef(Piece (AData[1], U,7),0); | |
1007 | cnt := 0; | |
1008 | for i := 2 to AData.Coun t-1 do | |
1009 | begi n | |
1010 | tm p := AData [i]; | |
1011 | p1 := Piece( tmp,U,1); | |
1012 | tm p := Piece (tmp,U,2); | |
1013 | if (p1 = 'D') then | |
1014 | FNotes := FNotes + t mp + CRLF | |
1015 | el se | |
1016 | if (p1 = 'U') then | |
1017 | FURL := tm p | |
1018 | el se | |
1019 | if (p1 = 'I') then | |
1020 | be gin | |
1021 | inc(cnt); | |
1022 | FItems := FItems + t mp + CRLF; | |
1023 | if(cnt=idx ) then | |
1024 | FItemDef ault := tm p; | |
1025 | en d; | |
1026 | end; | |
1027 | FReq uired := (Piece(ADa ta[1],U,8) = '1'); | |
1028 | FSep Lines := (Piece(ADa ta[1],U,9) = '1'); | |
1029 | FTex tLen := StrToIntDe f(Piece(AD ata[1],U,1 0),0); | |
1030 | FInd ent := StrToIntDe f(Piece(AD ata[1],U,1 1),0); | |
1031 | FPad := StrToIntDe f(Piece(AD ata[1],U,1 2),0); | |
1032 | FMin Val := StrToIntDe f(Piece(AD ata[1],U,1 3),0); | |
1033 | FMax Val := StrToIntDe f(Piece(AD ata[1],U,1 4),0); | |
1034 | FInc rement := StrToIntDe f(Piece(AD ata[1],U,1 5),0); | |
1035 | FDat eType := TemplateDa teCode2Dat eType(Piec e(AData[1] ,U,16)); | |
1036 | FMod ified := FALSE; | |
1037 | FNam eChanged : = FALSE; | |
1038 | end; | |
1039 | end; | |
1040 | if(AFID = 0) then | |
1041 | begin | |
1042 | inc(uN ewTemplate FieldIDCnt ); | |
1043 | FID := IntToStr( -uNewTempl ateFieldID Cnt); | |
1044 | FFldNa me := NewT emplateFie ld; | |
1045 | FModif ied := TRU E; | |
1046 | end; | |
1047 | if(not a ssigned(uT mplFlds)) then | |
1048 | uTmplF lds := TLi st.Create; | |
1049 | uTmplFld s.Add(Self ); | |
1050 | end; | |
1051 | ||
1052 | function T TemplateFi eld.GetTem plateField Default: s tring; | |
1053 | begin | |
1054 | case F FldType of | |
1055 | dftE ditBox, df tNumber: Result := FEditDefau lt; | |
1056 | ||
1057 | dftC omboBox, | |
1058 | dftB utton, | |
1059 | dftC heckBoxes, {Clear out embedded fields} | |
1060 | dftR adioButton s: Result := StripEmbed ded(FItemD efault); | |
1061 | ||
1062 | dftD ate: if FEditDe fault <> ' ' then Res ult := FEd itDefault; | |
1063 | ||
1064 | dftH yperlink, dftText: if FEditDe fault <> ' ' then | |
1065 | Result := StripEm bedded(FEd itDefault) | |
1066 | else | |
1067 | Result := URL; | |
1068 | ||
1069 | dftW P: Result := Items; | |
1070 | end; | |
1071 | end; | |
1072 | ||
1073 | procedure TTemplateF ield.Creat eDialogCon trols(Entr y: TTempla teDialogEn try; | |
1074 | var Index: In teger; Ctr lID: integ er); | |
1075 | ||
1076 | var | |
1077 | i, Aht, w, tmp, AW dth: integ er; | |
1078 | STmp: st ring; | |
1079 | TmpSL: T StringList ; | |
1080 | edt: TEd it; | |
1081 | cbo: TOR ComboBox; | |
1082 | cb: TORC heckBox; | |
1083 | btn: Tfr aTemplateF ieldButton ; | |
1084 | dbox: TO RDateBox; | |
1085 | dcbo: TO RDateCombo ; | |
1086 | lbl: TCP RSTemplate FieldLabel ; | |
1087 | re: TRic hEdit; | |
1088 | pnl: TCP RSDialogNu mber; | |
1089 | DefDate: TFMDateTi me; | |
1090 | ctrl: TC ontrol; | |
1091 | ||
1092 | function wdth: int eger; | |
1093 | begin | |
1094 | if(Awd th < 0) th en | |
1095 | Awdt h := FontW idthPixel( Entry.FFon t.Handle); | |
1096 | Result := Awdth; | |
1097 | end; | |
1098 | ||
1099 | function ht: integ er; | |
1100 | begin | |
1101 | if(Aht < 0) then | |
1102 | Aht := FontHei ghtPixel(E ntry.FFont .Handle); | |
1103 | Result := Aht; | |
1104 | end; | |
1105 | ||
1106 | procedur e UpdateIn dents(ACon trol: TCon trol); | |
1107 | var | |
1108 | idx: i nteger; | |
1109 | ||
1110 | begin | |
1111 | if (FI ndent > 0) or (FPad > 0) then | |
1112 | begin | |
1113 | idx := Entry.F Indents.In dexOfObjec t(AControl ); | |
1114 | if i dx < 0 the n | |
1115 | En try.FInden ts.AddObje ct(IntToSt r(FIndent * wdth) + U + IntToS tr(FPad), AControl); | |
1116 | end; | |
1117 | end; | |
1118 | ||
1119 | begin | |
1120 | if(not F Inactive) and (FFldT ype <> dft Unknown) t hen | |
1121 | begin | |
1122 | AWdth := -1; | |
1123 | Aht := -1; | |
1124 | ctrl : = nil; | |
1125 | ||
1126 | case F FldType of | |
1127 | dftE ditBox: | |
1128 | be gin | |
1129 | edt := TCP RSDialogFi eldEdit.Cr eate(nil); | |
1130 | (edt as IC PRSDialogC omponent). RequiredFi eld := Req uired; | |
1131 | edt.Parent := Entry. FPanel; | |
1132 | edt.Border Style := b sNone; | |
1133 | edt.Height := ht; | |
1134 | edt.Width := (wdth * Width + 4 ); | |
1135 | if FTextLe n > 0 then | |
1136 | edt.MaxL ength := F TextLen | |
1137 | else | |
1138 | edt.MaxL ength := F MaxLen; | |
1139 | edt.Text : = FEditDef ault; | |
1140 | edt.Tag := CtrlID; | |
1141 | edt.OnChan ge := Entr y.DoChange ; | |
1142 | UpdateColo rsFor508Co mpliance(e dt, TRUE); | |
1143 | ctrl := ed t; | |
1144 | en d; | |
1145 | ||
1146 | dftC omboBox: | |
1147 | be gin | |
1148 | cbo := TCP RSDialogCo mboBox.Cre ate(nil); | |
1149 | (cbo as IC PRSDialogC omponent). RequiredFi eld := Req uired; | |
1150 | cbo.Parent := Entry. FPanel; | |
1151 | cbo.Templa teField := TRUE; | |
1152 | w := Width ; | |
1153 | cbo.MaxLen gth := w; | |
1154 | if FTextLe n > 0 then | |
1155 | cbo.MaxL ength := F TextLen | |
1156 | else | |
1157 | cbo.List ItemsOnly := TRUE; | |
1158 | {Clear out embedded fields} | |
1159 | cbo.Items. Text := St ripEmbedde d(Items); | |
1160 | cbo.Select ByID(Strip Embedded(F ItemDefaul t)); | |
1161 | cbo.Tag := CtrlID; | |
1162 | cbo.OnChan ge := Entr y.DoChange ; | |
1163 | ||
1164 | if cbo.Ite ms.Count > 12 then | |
1165 | begin | |
1166 | cbo.Widt h := (wdth * w) + Sc rollBarWid th + 8; | |
1167 | cbo.Drop DownCount := 12; | |
1168 | end | |
1169 | else | |
1170 | begin | |
1171 | cbo.Widt h := (wdth * w) + 18 ; | |
1172 | cbo.Drop DownCount := cbo.Ite ms.Count; | |
1173 | end; | |
1174 | UpdateColo rsFor508Co mpliance(c bo, TRUE); | |
1175 | ctrl := cb o; | |
1176 | en d; | |
1177 | ||
1178 | dftB utton: | |
1179 | be gin | |
1180 | btn := Tfr aTemplateF ieldButton .Create(ni l); | |
1181 | (btn as IC PRSDialogC omponent). RequiredFi eld := Req uired; | |
1182 | btn.Parent := Entry. FPanel; | |
1183 | {Clear out embedded fields} | |
1184 | btn.Items. Text := St ripEmbedde d(Items); | |
1185 | btn.Button Text := St ripEmbedde d(FItemDef ault); | |
1186 | btn.Height := ht; | |
1187 | btn.Width := (wdth * Width) + 6; | |
1188 | btn.Tag := CtrlID; | |
1189 | btn.OnChan ge := Entr y.DoChange ; | |
1190 | UpdateColo rsFor508Co mpliance(b tn); | |
1191 | ctrl := bt n; | |
1192 | en d; | |
1193 | ||
1194 | dftC heckBoxes, dftRadioB uttons: | |
1195 | be gin | |
1196 | if FFldTyp e = dftRad ioButtons then | |
1197 | inc(uRad ioGroupInd ex); | |
1198 | TmpSL := T StringList .Create; | |
1199 | try | |
1200 | {Clear o ut embedde d fields} | |
1201 | TmpSL.Te xt := Stri pEmbedded( Items); | |
1202 | for i := 0 to TmpS L.Count-1 do | |
1203 | begin | |
1204 | cb := TCPRSDialo gCheckBox. Create(nil ); | |
1205 | if i = 0 then | |
1206 | (cb as ICPRSDi alogCompon ent).Requi redField : = Required ; | |
1207 | cb.Par ent := Ent ry.FPanel; | |
1208 | cb.Cap tion := Tm pSL[i]; | |
1209 | cb.Aut oSize := T RUE; | |
1210 | cb.Aut oAdjustSiz e; | |
1211 | // cb .AutoSize := FALSE; | |
1212 | // cb .Height := ht; | |
1213 | if FFl dType = df tRadioButt ons then | |
1214 | begin | |
1215 | cb.G roupIndex := uRadioG roupIndex; | |
1216 | cb.R adioStyle := TRUE; | |
1217 | end; | |
1218 | if(Tmp SL[i] = St ripEmbedde d(FItemDef ault)) the n | |
1219 | cb.C hecked := TRUE; | |
1220 | cb.Tag := CtrlID ; | |
1221 | if FSe pLines and (FFldType in SepLin esTypes) t hen | |
1222 | cb.S tringData := NewLine ; | |
1223 | cb.OnC lick := En try.DoChan ge; | |
1224 | Update ColorsFor5 08Complian ce(cb); | |
1225 | inc(In dex); | |
1226 | Entry. FControls. InsertObje ct(Index, '', cb); | |
1227 | if (i= 0) or FSep Lines then | |
1228 | Upda teIndents( cb); | |
1229 | end; | |
1230 | finally | |
1231 | TmpSL.Fr ee; | |
1232 | end; | |
1233 | en d; | |
1234 | ||
1235 | dftD ate: | |
1236 | be gin | |
1237 | if FEditDe fault <> ' ' then | |
1238 | DefDate := StrToFM DateTime(F EditDefaul t) | |
1239 | else | |
1240 | DefDate := 0; | |
1241 | if FDateTy pe in Date ComboTypes then | |
1242 | begin | |
1243 | dcbo := TCPRSDialo gDateCombo .Create(ni l); | |
1244 | (dcbo as ICPRSDial ogComponen t).Require dField := Required; | |
1245 | dcbo.Par ent := Ent ry.FPanel; | |
1246 | dcbo.Tag := CtrlID ; | |
1247 | dcbo.Inc ludeBtn := (FDateTyp e = dtComb o); | |
1248 | dcbo.Inc ludeDay := (FDateTyp e = dtComb o); | |
1249 | dcbo.Inc ludeMonth := (FDateT ype <> dtY ear); | |
1250 | dcbo.FMD ate := Def Date; | |
1251 | dcbo.Tem plateField := TRUE; | |
1252 | dcbo.OnC hange := E ntry.DoCha nge; | |
1253 | UpdateCo lorsFor508 Compliance (dcbo, TRU E); | |
1254 | ctrl := dcbo; | |
1255 | end | |
1256 | else | |
1257 | begin | |
1258 | dbox := TCPRSDialo gDateBox.C reate(nil) ; | |
1259 | (dbox as ICPRSDial ogComponen t).Require dField := Required; | |
1260 | dbox.Par ent := Ent ry.FPanel; | |
1261 | dbox.Tag := CtrlID ; | |
1262 | dbox.Dat eOnly := ( FDateType = dtDate); | |
1263 | dbox.Req uireTime : = (FDateTy pe = dtDat eReqTime); | |
1264 | dbox.Tem plateField := TRUE; | |
1265 | dbox.FMD ateTime := DefDate; | |
1266 | if (FDat eType = dt Date) then | |
1267 | tmp := 11 | |
1268 | else | |
1269 | tmp := 17; | |
1270 | dbox.Wid th := (wdt h * tmp) + 18; | |
1271 | dbox.OnC hange := E ntry.DoCha nge; | |
1272 | UpdateCo lorsFor508 Compliance (dbox, TRU E); | |
1273 | ctrl := dbox; | |
1274 | end; | |
1275 | en d; | |
1276 | ||
1277 | dftN umber: | |
1278 | be gin | |
1279 | pnl := TCP RSDialogNu mber.Creat ePanel(nil ); | |
1280 | (pnl as IC PRSDialogC omponent). RequiredFi eld := Req uired; | |
1281 | pnl.Parent := Entry. FPanel; | |
1282 | pnl.BevelO uter := bv None; | |
1283 | pnl.Tag := CtrlID; | |
1284 | pnl.Edit.H eight := h t; | |
1285 | pnl.Edit.W idth := (w dth * 5 + 4); | |
1286 | pnl.UpDown .Min := Mi nVal; | |
1287 | pnl.UpDown .Max := Ma xVal; | |
1288 | pnl.UpDown .Min := Mi nVal; // B oth ud.Min settings are needee d! | |
1289 | i := Incre ment; | |
1290 | if i < 1 t hen i := 1 ; | |
1291 | pnl.UpDown .Increment := i; | |
1292 | pnl.UpDown .Position := StrToIn tDef(EditD efault, 0) ; | |
1293 | pnl.Edit.O nChange := Entry.UpD ownChange; | |
1294 | pnl.Height := pnl.Ed it.Height; | |
1295 | pnl.Width := pnl.Edi t.Width + pnl.UpDown .Width; | |
1296 | UpdateColo rsFor508Co mpliance(p nl, TRUE); | |
1297 | //CQ 17597 wat | |
1298 | pnl.Edit.A lign := al Left; | |
1299 | pnl.UpDown .Align := alLeft; | |
1300 | //end 1759 7 | |
1301 | ctrl := pn l; | |
1302 | en d; | |
1303 | ||
1304 | dftH yperlink, dftText: | |
1305 | be gin | |
1306 | if (FFldTy pe = dftHy perlink) a nd User.We bAccess th en | |
1307 | lbl := T CPRSDialog HyperlinkL abel.Creat e(nil) | |
1308 | else | |
1309 | lbl := T CPRSTempla teFieldLab el.Create( nil); | |
1310 | lbl.Parent := Entry. FPanel; | |
1311 | lbl.ShowAc celChar := FALSE; | |
1312 | lbl.Exclud e := FSepL ines; | |
1313 | if (FFldTy pe = dftHy perlink) t hen | |
1314 | begin | |
1315 | if FEdit Default <> '' then | |
1316 | lbl.Ca ption := S tripEmbedd ed(FEditDe fault) | |
1317 | else | |
1318 | lbl.Ca ption := U RL; | |
1319 | end | |
1320 | else | |
1321 | begin | |
1322 | STmp := StripEmbed ded(Items) ; | |
1323 | if copy( STmp,lengt h(STmp)-1, 2) = CRLF then | |
1324 | delete (STmp,leng th(STmp)-1 ,2); | |
1325 | lbl.Capt ion := STm p; | |
1326 | end; | |
1327 | if lbl is TCPRSDialo gHyperlink Label then | |
1328 | TCPRSDia logHyperli nkLabel(lb l).Init(FU RL); | |
1329 | lbl.Tag := CtrlID; | |
1330 | UpdateColo rsFor508Co mpliance(l bl); | |
1331 | ctrl := lb l; | |
1332 | en d; | |
1333 | ||
1334 | dftW P: | |
1335 | be gin | |
1336 | re := TCPR SDialogRic hEdit.Crea te(nil); | |
1337 | (re as ICP RSDialogCo mponent).R equiredFie ld := Requ ired; | |
1338 | re.Parent := Entry.F Panel; | |
1339 | re.Tag := CtrlID; | |
1340 | tmp := FMa xLen; | |
1341 | if tmp < 5 then | |
1342 | tmp := 5 ; | |
1343 | re.Width : = wdth * t mp; | |
1344 | tmp := FTe xtLen; | |
1345 | if tmp < 2 then | |
1346 | tmp := 2 | |
1347 | else | |
1348 | if tmp > M axTFWPLine s then | |
1349 | tmp := M axTFWPLine s; | |
1350 | re.Height := ht * tm p; | |
1351 | re.BorderS tyle := bs None; | |
1352 | re.ScrollB ars := ssV ertical; | |
1353 | re.Lines.T ext := Ite ms; | |
1354 | re.OnChang e := Entry .DoChange; | |
1355 | UpdateColo rsFor508Co mpliance(r e, TRUE); | |
1356 | ctrl := re ; | |
1357 | en d; | |
1358 | end; | |
1359 | if ass igned(ctrl ) then | |
1360 | begin | |
1361 | inc( Index); | |
1362 | Entr y.FControl s.InsertOb ject(Index , '', ctrl ); | |
1363 | Upda teIndents( ctrl); | |
1364 | end; | |
1365 | end; | |
1366 | end; | |
1367 | ||
1368 | function T TemplateFi eld.CanMod ify: boole an; | |
1369 | begin | |
1370 | if((not FModified) and (not FLocked) a nd (StrToI ntDef(FID, 0) > 0)) t hen | |
1371 | begin | |
1372 | FLocke d := LockT emplateFie ld(FID); | |
1373 | Result := FLocke d; | |
1374 | if(not FLocked) then | |
1375 | Show Msg('Templ ate Field ' + FFldNa me + ' is currently being edit ed by anot her user.' ); | |
1376 | end | |
1377 | else | |
1378 | Result := TRUE; | |
1379 | if(Resul t) then FM odified := TRUE; | |
1380 | end; | |
1381 | ||
1382 | procedure TTemplateF ield.SetEd itDefault( const Valu e: string) ; | |
1383 | begin | |
1384 | if(FEdit Default <> Value) an d CanModif y then | |
1385 | FEditD efault := Value; | |
1386 | end; | |
1387 | ||
1388 | procedure TTemplateF ield.SetFl dName(cons t Value: s tring); | |
1389 | begin | |
1390 | if(FFldN ame <> Val ue) and Ca nModify th en | |
1391 | begin | |
1392 | FFldNa me := Valu e; | |
1393 | FNameC hanged := TRUE; | |
1394 | end; | |
1395 | end; | |
1396 | ||
1397 | procedure TTemplateF ield.SetFl dType(cons t Value: T TemplateFi eldType); | |
1398 | begin | |
1399 | if(FFldT ype <> Val ue) and Ca nModify th en | |
1400 | begin | |
1401 | FFldTy pe := Valu e; | |
1402 | if(Val ue = dftEd itBox) the n | |
1403 | begin | |
1404 | if ( FMaxLen < 1) then | |
1405 | FM axLen := 1 ; | |
1406 | if F TextLen < FMaxLen th en | |
1407 | FT extLen := FMaxLen; | |
1408 | end | |
1409 | else | |
1410 | if(Val ue = dftHy perlink) a nd (FURL = '') then | |
1411 | FURL := 'http: //' | |
1412 | else | |
1413 | if(Val ue = dftCo mboBox) an d (FMaxLen < 1) then | |
1414 | begin | |
1415 | FMax Len := Wid th; | |
1416 | if F MaxLen < 1 then | |
1417 | FM axLen := 1 ; | |
1418 | end | |
1419 | else | |
1420 | if(Val ue = dftWP ) then | |
1421 | begin | |
1422 | if ( FMaxLen = 0) then | |
1423 | FM axLen := M AX_ENTRY_W IDTH | |
1424 | else | |
1425 | if ( FMaxLen < 5) then | |
1426 | FMaxLen := 5; | |
1427 | if F TextLen < 2 then | |
1428 | FT extLen := 2; | |
1429 | end | |
1430 | else | |
1431 | if(Val ue = dftDa te) and (F DateType = dtUnknown ) then | |
1432 | FDat eType := d tDate; | |
1433 | end; | |
1434 | end; | |
1435 | ||
1436 | procedure TTemplateF ield.SetID (const Val ue: string ); | |
1437 | begin | |
1438 | // if(FID <> Value) and CanMo dify then | |
1439 | FID := Value; | |
1440 | end; | |
1441 | ||
1442 | procedure TTemplateF ield.SetIn active(con st Value: boolean); | |
1443 | begin | |
1444 | if(FInac tive <> Va lue) and C anModify t hen | |
1445 | FInact ive := Val ue; | |
1446 | end; | |
1447 | ||
1448 | procedure TTemplateF ield.SetIt emDefault( const Valu e: string) ; | |
1449 | begin | |
1450 | if(FItem Default <> Value) an d CanModif y then | |
1451 | FItemD efault := Value; | |
1452 | end; | |
1453 | ||
1454 | procedure TTemplateF ield.SetIt ems(const Value: str ing); | |
1455 | begin | |
1456 | if(FItem s <> Value ) and CanM odify then | |
1457 | FItems := Value; | |
1458 | end; | |
1459 | ||
1460 | procedure TTemplateF ield.SetLM Text(const Value: st ring); | |
1461 | begin | |
1462 | if(FLMTe xt <> Valu e) and Can Modify the n | |
1463 | FLMTex t := Value ; | |
1464 | end; | |
1465 | ||
1466 | procedure TTemplateF ield.SetMa xLen(const Value: in teger); | |
1467 | begin | |
1468 | if(FMaxL en <> Valu e) and Can Modify the n | |
1469 | FMaxLe n := Value ; | |
1470 | end; | |
1471 | ||
1472 | procedure TTemplateF ield.SetNo tes(const Value: str ing); | |
1473 | begin | |
1474 | if(FNote s <> Value ) and CanM odify then | |
1475 | FNotes := Value; | |
1476 | end; | |
1477 | ||
1478 | function T TemplateFi eld.SaveEr ror: strin g; | |
1479 | var | |
1480 | TmpSL, F ldSL: TStr ingList; | |
1481 | AID,Res: string; | |
1482 | idx, i: integer; | |
1483 | IEN64: I nt64; | |
1484 | NewRec: boolean; | |
1485 | ||
1486 | begin | |
1487 | if(FFldN ame = NewT emplateFie ld) then | |
1488 | begin | |
1489 | Result := 'Templ ate Field can not be named "' + NewTempl ateField + '"'; | |
1490 | exit; | |
1491 | end; | |
1492 | Result : = ''; | |
1493 | NewRec : = (StrToIn tDef(FID,0 ) < 0); | |
1494 | if(FModi fied or Ne wRec) then | |
1495 | begin | |
1496 | TmpSL := TString List.Creat e; | |
1497 | try | |
1498 | FldS L := TStri ngList.Cre ate; | |
1499 | try | |
1500 | if (StrToIntD ef(FID,0) > 0) then | |
1501 | AID := FID | |
1502 | el se | |
1503 | AID := '0' ; | |
1504 | Fl dSL.Add('. 01='+FFldN ame); | |
1505 | Fl dSL.Add('. 02='+Templ ateFieldTy peCodes[FF ldType]); | |
1506 | Fl dSL.Add('. 03='+BOOLC HAR[FInact ive]); | |
1507 | Fl dSL.Add('. 04='+IntTo Str(FMaxLe n)); | |
1508 | Fl dSL.Add('. 05='+FEdit Default); | |
1509 | Fl dSL.Add('. 06='+FLMTe xt); | |
1510 | id x := -1; | |
1511 | if (FItems <> '') and ( FItemDefau lt <> '') then | |
1512 | be gin | |
1513 | TmpSL.Text := FItems ; | |
1514 | for i := 0 to TmpSL. Count-1 do | |
1515 | if(FItem Default = TmpSL[i]) then | |
1516 | begin | |
1517 | idx := i; | |
1518 | break; | |
1519 | end; | |
1520 | en d; | |
1521 | Fl dSL.Add('. 07='+IntTo Str(Idx+1) ); | |
1522 | Fl dSL.Add('. 08='+BOOLC HAR[fRequi red]); | |
1523 | Fl dSL.Add('. 09='+BOOLC HAR[fSepLi nes]); | |
1524 | Fl dSL.Add('. 1=' +IntTo Str(FTextL en)); | |
1525 | Fl dSL.Add('. 11='+IntTo Str(FInden t)); | |
1526 | Fl dSL.Add('. 12='+IntTo Str(FPad)) ; | |
1527 | Fl dSL.Add('. 13='+IntTo Str(FMinVa l)); | |
1528 | Fl dSL.Add('. 14='+IntTo Str(FMaxVa l)); | |
1529 | Fl dSL.Add('. 15='+IntTo Str(FIncre ment)); | |
1530 | if FDateType = dtUnkno wn then | |
1531 | FldSL.Add( '.16=@') | |
1532 | el se | |
1533 | FldSL.Add( '.16='+Tem plateField DateCodes[ FDateType] ); | |
1534 | ||
1535 | if FURL='' t hen | |
1536 | FldSL.Add( '3=@') | |
1537 | el se | |
1538 | FldSL.Add( '3='+FURL) ; | |
1539 | ||
1540 | if (FNotes <> '') or (n ot NewRec) then | |
1541 | be gin | |
1542 | if(FNotes = '') then | |
1543 | FldSL.Ad d('2,1=@') | |
1544 | else | |
1545 | begin | |
1546 | TmpSL.Te xt := FNot es; | |
1547 | for i := 0 to TmpS L.Count-1 do | |
1548 | FldSL. Add('2,'+I ntToStr(i+ 1)+',0='+T mpSL[i]); | |
1549 | end; | |
1550 | en d; | |
1551 | if ((FItems < > '') or ( not NewRec )) then | |
1552 | be gin | |
1553 | if(FItems = '') then | |
1554 | FldSL.Ad d('10,1=@' ) | |
1555 | else | |
1556 | begin | |
1557 | TmpSL.Te xt := FIte ms; | |
1558 | for i := 0 to TmpS L.Count-1 do | |
1559 | FldSL. Add('10,'+ IntToStr(i +1)+',0='+ TmpSL[i]); | |
1560 | end; | |
1561 | en d; | |
1562 | ||
1563 | Re s := Updat eTemplateF ield(AID, FldSL); | |
1564 | IE N64 := Str ToInt64Def (Piece(Res ,U,1),0); | |
1565 | if (IEN64 > 0 ) then | |
1566 | be gin | |
1567 | if(NewRec) then | |
1568 | FID := I ntToStr(IE N64) | |
1569 | else | |
1570 | UnlockTe mplateFiel d(FID); | |
1571 | FModified := FALSE; | |
1572 | FNameChang ed := FALS E; | |
1573 | FLocked := FALSE; | |
1574 | en d | |
1575 | el se | |
1576 | Result := Piece(Res, U, 2); | |
1577 | fina lly | |
1578 | Fl dSL.Free; | |
1579 | end; | |
1580 | finall y | |
1581 | TmpS L.Free; | |
1582 | end; | |
1583 | end; | |
1584 | end; | |
1585 | ||
1586 | procedure TTemplateF ield.Assig n(AFld: TT emplateFie ld); | |
1587 | begin | |
1588 | FMaxLen := AFld.FMaxL en; | |
1589 | FFldName := AFld.FFldN ame; | |
1590 | FLMText := AFld.FLMTe xt; | |
1591 | FEditDef ault := AFld.FEdit Default; | |
1592 | FNotes := AFld.FNote s; | |
1593 | FItems := AFld.FItem s; | |
1594 | FInactiv e := AFld.FInac tive; | |
1595 | FItemDef ault := AFld.FItem Default; | |
1596 | FFldType := AFld.FFldT ype; | |
1597 | FRequire d := AFld.FRequ ired; | |
1598 | FSepLine s := AFld.FSepL ines; | |
1599 | FTextLen := AFld.FText Len; | |
1600 | FIndent := AFld.FInde nt; | |
1601 | FPad := AFld.FPad; | |
1602 | FMinVal := AFld.FMinV al; | |
1603 | FMaxVal := AFld.FMaxV al; | |
1604 | FIncreme nt := AFld.FIncr ement; | |
1605 | FDateTyp e := AFld.FDate Type; | |
1606 | FURL := AFld.FURL; | |
1607 | end; | |
1608 | ||
1609 | function T TemplateFi eld.Width: integer; | |
1610 | var | |
1611 | i, ilen: integer; | |
1612 | TmpSL: T StringList ; | |
1613 | ||
1614 | begin | |
1615 | if(FFldT ype = dftE ditBox) th en | |
1616 | Result := FMaxLe n | |
1617 | else | |
1618 | begin | |
1619 | if FMa xLen > 0 t hen | |
1620 | Resu lt := FMax Len | |
1621 | else | |
1622 | begin | |
1623 | Resu lt := -1; | |
1624 | TmpS L := TStri ngList.Cre ate; | |
1625 | try | |
1626 | Tm pSL.Text : = StripEmb edded(FIte ms); | |
1627 | fo r i := 0 t o TmpSL.Co unt-1 do | |
1628 | be gin | |
1629 | ilen := le ngth(TmpSL [i]); | |
1630 | if(Result < ilen) th en | |
1631 | Result : = ilen; | |
1632 | en d; | |
1633 | fina lly | |
1634 | Tm pSL.Free; | |
1635 | end; | |
1636 | end; | |
1637 | end; | |
1638 | if Resul t > MaxTFE dtLen then | |
1639 | Result := MaxTFE dtLen; | |
1640 | end; | |
1641 | ||
1642 | destructor TTemplate Field.Dest roy; | |
1643 | begin | |
1644 | uTmplFld s.Remove(S elf); | |
1645 | inherite d; | |
1646 | end; | |
1647 | ||
1648 | procedure TTemplateF ield.SetRe quired(con st Value: boolean); | |
1649 | begin | |
1650 | if(FRequ ired <> Va lue) and C anModify t hen | |
1651 | FRequi red := Val ue; | |
1652 | end; | |
1653 | ||
1654 | function T TemplateFi eld.NewFie ld: boolea n; | |
1655 | begin | |
1656 | Result : = (StrToIn tDef(FID,0 ) <= 0); | |
1657 | end; | |
1658 | ||
1659 | procedure TTemplateF ield.SetSe pLines(con st Value: boolean); | |
1660 | begin | |
1661 | if(FSepL ines <> Va lue) and C anModify t hen | |
1662 | FSepLi nes := Val ue | |
1663 | end; | |
1664 | ||
1665 | procedure TTemplateF ield.SetIn crement(co nst Value: integer); | |
1666 | begin | |
1667 | if(FIncr ement <> V alue) and CanModify then | |
1668 | FIncre ment := Va lue; | |
1669 | end; | |
1670 | ||
1671 | procedure TTemplateF ield.SetIn dent(const Value: in teger); | |
1672 | begin | |
1673 | if(FInde nt <> Valu e) and Can Modify the n | |
1674 | FInden t := Value ; | |
1675 | end; | |
1676 | ||
1677 | procedure TTemplateF ield.SetMa xVal(const Value: in teger); | |
1678 | begin | |
1679 | if(FMaxV al <> Valu e) and Can Modify the n | |
1680 | FMaxVa l := Value ; | |
1681 | end; | |
1682 | ||
1683 | procedure TTemplateF ield.SetMi nVal(const Value: in teger); | |
1684 | begin | |
1685 | if(FMinV al <> Valu e) and Can Modify the n | |
1686 | FMinVa l := Value ; | |
1687 | end; | |
1688 | ||
1689 | procedure TTemplateF ield.SetPa d(const Va lue: integ er); | |
1690 | begin | |
1691 | if(FPad <> Value) and CanMod ify then | |
1692 | FPad : = Value; | |
1693 | end; | |
1694 | ||
1695 | procedure TTemplateF ield.SetTe xtLen(cons t Value: i nteger); | |
1696 | begin | |
1697 | if(FText Len <> Val ue) and Ca nModify th en | |
1698 | FTextL en := Valu e; | |
1699 | end; | |
1700 | ||
1701 | procedure TTemplateF ield.SetUR L(const Va lue: strin g); | |
1702 | begin | |
1703 | if(FURL <> Value) and CanMod ify then | |
1704 | FURL : = Value; | |
1705 | end; | |
1706 | ||
1707 | function T TemplateFi eld.GetReq uired: boo lean; | |
1708 | begin | |
1709 | if FFldT ype in NoR equired th en | |
1710 | Result := FALSE | |
1711 | else | |
1712 | Result := FRequi red; | |
1713 | end; | |
1714 | ||
1715 | procedure TTemplateF ield.SetDa teType(con st Value: TTmplFldDa teType); | |
1716 | begin | |
1717 | if(FDate Type <> Va lue) and C anModify t hen | |
1718 | FDateT ype := Val ue; | |
1719 | end; | |
1720 | ||
1721 | { TTemplat eDialogEnt ry } | |
1722 | const | |
1723 | EOL_MARK ER = #182; | |
1724 | SR_BREAK = #186; | |
1725 | ||
1726 | procedure PanelDestr oy(AData: Pointer; S ender: TOb ject); | |
1727 | var | |
1728 | idx: int eger; | |
1729 | dlg: TTe mplateDial ogEntry; | |
1730 | ||
1731 | begin | |
1732 | dlg := T TemplateDi alogEntry( AData); | |
1733 | idx := u Entries.In dexOf(dlg. FID); | |
1734 | if(idx > = 0) then | |
1735 | uEntri es.Delete( idx); | |
1736 | dlg.FPan elDying := TRUE; | |
1737 | dlg.Free ; | |
1738 | end; | |
1739 | ||
1740 | constructo r TTemplat eDialogEnt ry.Create( AParent: T WinControl ; AID, Tex t: string) ; | |
1741 | var | |
1742 | CtrlID, idx, i, j, flen: int eger; | |
1743 | txt, Fld Name: stri ng; | |
1744 | Fld: TTe mplateFiel d; | |
1745 | ||
1746 | begin | |
1747 | FID := A ID; | |
1748 | FText := Text; | |
1749 | FControl s := TStri ngList.Cre ate; | |
1750 | FIndents := TStrin gList.Crea te; | |
1751 | FFont := TFont.Cre ate; | |
1752 | FFont.As sign(TOREx posedContr ol(AParent ).Font); | |
1753 | FControl s.Text := Text; | |
1754 | if(FCont rols.Count > 1) then | |
1755 | begin | |
1756 | for i := 1 to FC ontrols.Co unt-1 do | |
1757 | FCon trols[i] : = EOL_MARK ER + FCont rols[i]; | |
1758 | if not ScreenRea derSystemA ctive then | |
1759 | Stri pScreenRea derCodes(F Controls); | |
1760 | end; | |
1761 | FFirstBu ild := TRU E; | |
1762 | FPanel : = TDlgFiel dPanel.Cre ate(AParen t.Owner); | |
1763 | FPanel.P arent := A Parent; | |
1764 | FPanel.B evelOuter := bvNone; | |
1765 | FPanel.C aption := ''; | |
1766 | FPanel.F ont.Assign (FFont); | |
1767 | UpdateCo lorsFor508 Compliance (FPanel, T RUE); | |
1768 | idx := 0 ; | |
1769 | while (i dx < FCont rols.Count ) do | |
1770 | begin | |
1771 | txt := FControls [idx]; | |
1772 | i := p os(Templat eFieldBegi nSignature , txt); | |
1773 | if(i > 0) then | |
1774 | begin | |
1775 | if(c opy(txt, i + Templat eFieldSign atureLen, 1) = Field IDDelim) t hen | |
1776 | begi n | |
1777 | Ct rlID := St rToIntDef( copy(txt, i + Templa teFieldSig natureLen + 1, Field IDLen-1), 0); | |
1778 | de lete(txt,i + Templat eFieldSign atureLen, FieldIDLen ); | |
1779 | end | |
1780 | else | |
1781 | Ct rlID := 0; | |
1782 | j := pos(Templ ateFieldEn dSignature , copy(txt , i + Temp lateFieldS ignatureLe n, MaxInt) ); | |
1783 | if(j > 0) then | |
1784 | begi n | |
1785 | in c(j, i + T emplateFie ldSignatur eLen - 1); | |
1786 | fl en := j - i - Templa teFieldSig natureLen; | |
1787 | Fl dName := c opy(txt, i + Templat eFieldSign atureLen, flen); | |
1788 | Fl d := GetTe mplateFiel d(FldName, FALSE); | |
1789 | de lete(txt,i ,flen + Te mplateFiel dSignature Len + 1); | |
1790 | if (assigned( Fld)) then | |
1791 | be gin | |
1792 | FControls[ idx] := co py(txt,1,i -1); | |
1793 | if(Fld.Req uired) the n | |
1794 | begin | |
1795 | if Scree nReaderSys temActive then | |
1796 | begin | |
1797 | if Fld .FFldType in [dftChe ckBoxes, d ftRadioBut tons] then | |
1798 | FCon trols[idx] := FContr ols[idx] + ScreenRea derStopCod e; | |
1799 | end; | |
1800 | FControl s[idx] := FControls[ idx] + '*' ; | |
1801 | end; | |
1802 | Fld.Create DialogCont rols(Self, idx, Ctrl ID); | |
1803 | FControls. Insert(idx +1,copy(tx t,i,MaxInt )); | |
1804 | en d | |
1805 | el se | |
1806 | be gin | |
1807 | FControls[ idx] := tx t; | |
1808 | dec(idx); | |
1809 | en d; | |
1810 | end | |
1811 | else | |
1812 | begi n | |
1813 | de lete(txt,i ,TemplateF ieldSignat ureLen); | |
1814 | FC ontrols[id x] := txt; | |
1815 | de c(idx); | |
1816 | end; | |
1817 | end; | |
1818 | inc(id x); | |
1819 | end; | |
1820 | if Scree nReaderSys temActive then | |
1821 | begin | |
1822 | idx := 0; | |
1823 | while (idx < FCo ntrols.Cou nt) do | |
1824 | begin | |
1825 | txt := FContro ls[idx]; | |
1826 | i := pos(Scree nReaderSto pCode, txt ); | |
1827 | if i > 0 then | |
1828 | begi n | |
1829 | FC ontrols[id x] := copy (txt, 1, i -1); | |
1830 | tx t := copy( txt, i + S creenReade rStopCodeL en, MaxInt ); | |
1831 | FC ontrols.In sert(idx+1 , SR_BREAK + txt); | |
1832 | end; | |
1833 | inc( idx); | |
1834 | end; | |
1835 | end; | |
1836 | end; | |
1837 | ||
1838 | destructor TTemplate DialogEntr y.Destroy; | |
1839 | begin | |
1840 | if assig ned(FOnDes troy) then | |
1841 | FOnDes troy(Self) ; | |
1842 | KillLabe ls; | |
1843 | KillObj( @FControls , TRUE); | |
1844 | if FPane lDying the n | |
1845 | FPanel := nil | |
1846 | else | |
1847 | FreeAn dNil(FPane l); | |
1848 | FreeAndN il(FFont); | |
1849 | FreeAndN il(FIndent s); | |
1850 | inherite d; | |
1851 | end; | |
1852 | ||
1853 | procedure TTemplateD ialogEntry .DoChange( Sender: TO bject); | |
1854 | begin | |
1855 | if (not FUpdating) and assig ned(FOnCha nge) then | |
1856 | FOnCha nge(Self); | |
1857 | end; | |
1858 | ||
1859 | function T TemplateDi alogEntry. GetControl Text(CtrlI D: integer ; NoCommas : boolean; | |
1860 | va r FoundEnt ry: boolea n; AutoWra p: boolean ; | |
1861 | em Field: str ing = ''): string; | |
1862 | var | |
1863 | x, i, j, ind, idx: integer; | |
1864 | Ctrl: TC ontrol; | |
1865 | Done: bo olean; | |
1866 | iString: string; | |
1867 | iField: TTemplateF ield; | |
1868 | iTemp: T StringList ; | |
1869 | ||
1870 | function GetOrigin alItem(ist r: string) : string; | |
1871 | begin | |
1872 | Result := ''; | |
1873 | if emF ield <> '' then | |
1874 | begi n | |
1875 | iF ield := Ge tTemplateF ield(emFie ld,FALSE); | |
1876 | iT emp := nil ; | |
1877 | if ifield <> nil then | |
1878 | try | |
1879 | iTemp := TStringLi st.Create; | |
1880 | iTemp.Te xt := Stri pEmbedded( iField.Ite ms); | |
1881 | x := iTe mp.IndexOf (istr); | |
1882 | if x >= 0 then | |
1883 | begin | |
1884 | iTemp. Text := iF ield.Items ; | |
1885 | Result := iTemp. Strings[x] ; | |
1886 | end; | |
1887 | finally | |
1888 | iTemp.Fr ee; | |
1889 | end; | |
1890 | end; | |
1891 | end; | |
1892 | ||
1893 | ||
1894 | begin | |
1895 | Result : = ''; | |
1896 | Done := FALSE; | |
1897 | ind := - 1; | |
1898 | for i := 0 to FCon trols.Coun t-1 do | |
1899 | begin | |
1900 | Ctrl : = TControl (FControls .Objects[i ]); | |
1901 | if(ass igned(Ctrl )) and (Ct rl.Tag = C trlID) the n | |
1902 | begin | |
1903 | Foun dEntry := TRUE; | |
1904 | Done := TRUE; | |
1905 | if i nd < 0 the n | |
1906 | begi n | |
1907 | id x := FInde nts.IndexO fObject(Ct rl); | |
1908 | if idx >= 0 then | |
1909 | ind := Str ToIntDef(P iece(FInde nts[idx], U, 2), 0) | |
1910 | el se | |
1911 | ind := 0; | |
1912 | end; | |
1913 | if(C trl is TCP RSTemplate FieldLabel ) then | |
1914 | begi n | |
1915 | if not TCPRS TemplateFi eldLabel(C trl).Exclu de then be gin | |
1916 | if emField <> '' the n begin | |
1917 | iField : = GetTempl ateField(e mField,FAL SE); | |
1918 | case iFi eld.FldTyp e of | |
1919 | dftHyp erlink: if iField.Ed itDefault <> '' then | |
1920 | Result := iField.Edi tDefault | |
1921 | el se | |
1922 | Result := iField.URL ; | |
1923 | dftTex t: be gin | |
1924 | iString := iField.It ems; | |
1925 | if copy(iS tring,leng th(iString )-1,2) = C RLF then | |
1926 | delete(i String,len gth(iStrin g)-1,2); | |
1927 | Result := iString; | |
1928 | en d; | |
1929 | else {ca se} | |
1930 | Result := TCPRST emplateFie ldLabel(Ct rl).Captio n | |
1931 | end; {ca se iField. FldType} | |
1932 | end {if emField} | |
1933 | else | |
1934 | Result : = TCPRSTem plateField Label(Ctrl ).Caption; | |
1935 | en d; | |
1936 | end | |
1937 | else | |
1938 | //!!!!!! C ODE ADDED BACK IN - DN S BELLC !!!! !! | |
1939 | if(C trl is TEd it) then | |
1940 | Re sult := TE dit(Ctrl). Text | |
1941 | else | |
1942 | if(C trl is TOR ComboBox) then begin | |
1943 | Re sult := TO RComboBox( Ctrl).Text ; | |
1944 | iS tring := G etOriginal Item(Resul t); | |
1945 | if iString < > '' then | |
1946 | Result := iString; | |
1947 | en d | |
1948 | else | |
1949 | if(C trl is TOR DateCombo) then | |
1950 | Re sult := TO RDateCombo (Ctrl).Tex t + ':' + FloatToStr (TORDateCo mbo(Ctrl). FMDate) | |
1951 | else | |
1952 | {!!!!!! TH IS HAS BEE N REMOVED AS IT CAUS ED PROBLEM S WITH REM INDER DIAL OGS - DN S BELLC !!!! !! | |
1953 | if(C trl is TOR DateBox) t hen begin | |
1954 | if TORDateBo x(Ctrl).Is Valid then | |
1955 | R esult := T ORDateBox( Ctrl).Text | |
1956 | el se | |
1957 | R esult := ' '; | |
1958 | end else | |
1959 | } | |
1960 | //!!!!!! C ODE ADDED BACK IN - DN S BELLC !!!! !! | |
1961 | if(C trl is TOR DateBox) t hen | |
1962 | Re sult := TO RDateBox(C trl).Text | |
1963 | else | |
1964 | if(C trl is TRi chEdit) th en | |
1965 | begi n | |
1966 | if ((ind = 0) and (not AutoWrap)) then | |
1967 | Result := TRichEdit( Ctrl).Line s.Text | |
1968 | el se | |
1969 | be gin | |
1970 | for j := 0 to TRichE dit(Ctrl). Lines.Coun t-1 do | |
1971 | begin | |
1972 | if AutoW rap then | |
1973 | begin | |
1974 | if(Res ult <> '') then | |
1975 | Resu lt := Resu lt + ' '; | |
1976 | Result := Result + TRichEd it(Ctrl).L ines[j]; | |
1977 | end | |
1978 | else | |
1979 | begin | |
1980 | if(Res ult <> '') then | |
1981 | Resu lt := Resu lt + CRLF; | |
1982 | Result := Result + StringO fChar(' ', ind) + TR ichEdit(Ct rl).Lines[ j]; | |
1983 | end; | |
1984 | end; | |
1985 | ind := 0; | |
1986 | en d; | |
1987 | end | |
1988 | else | |
1989 | {!!!!!! TH IS HAS BEE N REMOVED AS IT CAUS ED PROBLEM S WITH REM INDER DIAL OGS - DN S BELLC !!!! !! | |
1990 | if(C trl is TEd it) then | |
1991 | Re sult := TE dit(Ctrl). Text | |
1992 | else } | |
1993 | if(C trl is TOR CheckBox) then | |
1994 | begi n | |
1995 | Do ne := FALS E; | |
1996 | if (TORCheckB ox(Ctrl).C hecked) th en | |
1997 | be gin | |
1998 | if(Result <> '') the n | |
1999 | begin | |
2000 | if NoCom mas then | |
2001 | Result := Result + '|' | |
2002 | else | |
2003 | Result := Result + ', '; | |
2004 | end; | |
2005 | iString := GetOrigin alItem(TOR CheckBox(C trl).Capti on); | |
2006 | if iString <> '' the n | |
2007 | Result : = Result + iString | |
2008 | else | |
2009 | Result : = Result + TORCheckB ox(Ctrl).C aption; | |
2010 | en d; | |
2011 | end | |
2012 | else | |
2013 | if(C trl is Tfr aTemplateF ieldButton ) then | |
2014 | be gin | |
2015 | Result := TfraTempla teFieldBut ton(Ctrl). ButtonText ; | |
2016 | iString := GetOrigin alItem(Res ult); | |
2017 | if iString <> '' the n | |
2018 | Result : = iString; | |
2019 | en d | |
2020 | else | |
2021 | if(C trl is TPa nel) then | |
2022 | begi n | |
2023 | fo r j := 0 t o Ctrl.Com ponentCoun t-1 do | |
2024 | if Ctrl.Co mponents[j ] is TUpDo wn then | |
2025 | begin | |
2026 | Result : = IntToStr (TUpDown(C trl.Compon ents[j]).P osition); | |
2027 | break; | |
2028 | end; | |
2029 | end; | |
2030 | end; | |
2031 | if Don e then bre ak; | |
2032 | end; | |
2033 | if (ind > 0) and ( not NoComm as) then | |
2034 | Result := String OfChar(' ' , ind) + R esult; | |
2035 | end; | |
2036 | ||
2037 | function T TemplateDi alogEntry. GetFieldVa lues: stri ng; | |
2038 | var | |
2039 | i: integ er; | |
2040 | Ctrl: TC ontrol; | |
2041 | CtrlID: integer; | |
2042 | TmpIDs: TList; | |
2043 | TmpSL: T StringList ; | |
2044 | Dummy: b oolean; | |
2045 | ||
2046 | begin | |
2047 | Result : = ''; | |
2048 | TmpIDs : = TList.Cr eate; | |
2049 | try | |
2050 | TmpSL := TString List.Creat e; | |
2051 | try | |
2052 | for i := 0 to FControls. Count-1 do | |
2053 | begi n | |
2054 | Ct rl := TCon trol(FCont rols.Objec ts[i]); | |
2055 | if (assigned( Ctrl)) the n | |
2056 | be gin | |
2057 | CtrlID := Ctrl.Tag; | |
2058 | if(TmpIDs. IndexOf(Po inter(Ctrl ID)) < 0) then | |
2059 | begin | |
2060 | TmpSL.Ad d(IntToStr (CtrlID) + U + GetCo ntrolText( CtrlID, TR UE, Dummy, FALSE)); | |
2061 | TmpIDs.A dd(Pointer (CtrlID)); | |
2062 | end; | |
2063 | en d; | |
2064 | end; | |
2065 | Resu lt := TmpS L.CommaTex t; | |
2066 | finall y | |
2067 | TmpS L.Free; | |
2068 | end; | |
2069 | finally | |
2070 | TmpIDs .Free; | |
2071 | end; | |
2072 | end; | |
2073 | ||
2074 | function T TemplateDi alogEntry. GetPanel(M axLen: int eger; APar ent: TWinC ontrol; | |
2075 | O wningCheck Box: TCPRS DialogPare ntCheckBox ): TDlgFie ldPanel; | |
2076 | var | |
2077 | i, x, y, cnt, idx, ind, yinc , ybase, M axX: integ er; | |
2078 | MaxTextL en: intege r; {Max n um of char s per line in pixels } | |
2079 | MaxChars : integer; {Max n um of char s per line } | |
2080 | txt: str ing; | |
2081 | ctrl: TC ontrol; | |
2082 | LastLine Blank: boo lean; | |
2083 | sLbl: TC PRSDialogS taticLabel ; | |
2084 | nLbl: TV A508Chaine dLabel; | |
2085 | sLblHeig ht: intege r; | |
2086 | TabOrdr: integer; | |
2087 | const | |
2088 | FOCUS_RE CT_MARGIN = 2; {The margin aro und the pa nel so the label won 't | |
2089 | overla y the focu s rect on its parent panel.} | |
2090 | ||
2091 | procedur e Add2TabO rder(ctrl: TWinContr ol); | |
2092 | begin | |
2093 | ctrl.T abOrder := TabOrdr; | |
2094 | inc(Ta bOrdr); | |
2095 | end; | |
2096 | ||
2097 | function StripSRCo de(var txt : string; code: stri ng; len: i nteger): i nteger; | |
2098 | begin | |
2099 | Result := pos(co de, txt); | |
2100 | if Res ult > 0 th en | |
2101 | begin | |
2102 | dele te(txt,Res ult,len); | |
2103 | dec( Result); | |
2104 | end | |
2105 | else | |
2106 | Resu lt := -1; | |
2107 | end; | |
2108 | ||
2109 | procedur e DoLabel( Atxt: stri ng); | |
2110 | var | |
2111 | ctrl: TControl; | |
2112 | tempLb l: TVA508C hainedLabe l; | |
2113 | ||
2114 | begin | |
2115 | if Scr eenReaderS ystemActiv e then | |
2116 | begin | |
2117 | if a ssigned(sL bl) then | |
2118 | begi n | |
2119 | te mpLbl := T VA508Chain edLabel.Cr eate(nil); | |
2120 | if assigned( nLbl) then | |
2121 | nLbl.NextL abel := te mpLbl | |
2122 | el se | |
2123 | sLbl.NextL abel := te mpLbl; | |
2124 | nL bl := temp Lbl; | |
2125 | ct rl := nLbl ; | |
2126 | end | |
2127 | else | |
2128 | begi n | |
2129 | sL bl := TCPR SDialogSta ticLabel.C reate(nil) ; | |
2130 | ct rl := sLbl ; | |
2131 | end; | |
2132 | end | |
2133 | else | |
2134 | ctrl := TLabel .Create(ni l); | |
2135 | SetOrd Prop(ctrl, ShowAccel CharProper ty, ord(FA LSE)); | |
2136 | SetStr Prop(ctrl, CaptionPr operty, At xt); | |
2137 | ctrl.P arent := F Panel; | |
2138 | ctrl.L eft := x; | |
2139 | ctrl.T op := y; | |
2140 | if ctr l = sLbl t hen | |
2141 | begin | |
2142 | Add2 TabOrder(s Lbl); | |
2143 | sLbl .Height := sLblHeigh t; | |
2144 | Scre enReaderSy stem_Curre ntLabel(sL bl); | |
2145 | end; | |
2146 | if Scr eenReaderS ystemActiv e then | |
2147 | Scre enReaderSy stem_AddTe xt(Atxt); | |
2148 | Update ColorsFor5 08Complian ce(ctrl); | |
2149 | inc(x, ctrl.Widt h); | |
2150 | end; | |
2151 | ||
2152 | procedur e Init; | |
2153 | var | |
2154 | lbl : TLabel; | |
2155 | begin | |
2156 | if(FFi rstBuild) then | |
2157 | FFir stBuild := FALSE | |
2158 | else | |
2159 | Kill Labels; | |
2160 | y := F OCUS_RECT_ MARGIN; {p lacement o f labels o n panel so they don' t cover th e} | |
2161 | x := F OCUS_RECT_ MARGIN; {f ocus recta ngle} | |
2162 | MaxX : = 0; | |
2163 | //ybas e := FontH eightPixel (FFont.Han dle) + 1 + (FOCUS_RE CT_MARGIN * 2); AGP commentou t line for | |
2164 | //rem inder spac ing | |
2165 | ybase := FontHei ghtPixel(F Font.Handl e) + 2; | |
2166 | yinc : = ybase; | |
2167 | LastLi neBlank := FALSE; | |
2168 | sLbl : = nil; | |
2169 | nLbl : = nil; | |
2170 | TabOrd r := 0; | |
2171 | if Scr eenReaderS ystemActiv e then | |
2172 | begin | |
2173 | Scre enReaderSy stem_Curre ntCheckBox (OwningChe ckBox); | |
2174 | lbl := TLabel. Create(nil ); | |
2175 | try | |
2176 | lb l.Parent : = FPanel; | |
2177 | sL blHeight : = lbl.Heig ht + 2; | |
2178 | fina lly | |
2179 | lb l.Free; | |
2180 | end; | |
2181 | ||
2182 | end; | |
2183 | end; | |
2184 | ||
2185 | procedur e Text508W ork; | |
2186 | var | |
2187 | Contin ueCode: bo olean; | |
2188 | begin | |
2189 | if Str ipCode(txt , SR_BREAK ) then | |
2190 | begin | |
2191 | Scre enReaderSy stem_Stop; | |
2192 | nLbl := nil; | |
2193 | sLbl := nil; | |
2194 | end; | |
2195 | ||
2196 | Contin ueCode := FALSE; | |
2197 | while StripSRCod e(txt, Scr eenReaderC ontinueCod e, ScreenR eaderConti nueCodeLen ) >= 0 do | |
2198 | Cont inueCode : = TRUE; | |
2199 | while StripSRCod e(txt, Scr eenReaderC ontinueCod eOld, Scre enReaderCo ntinueCode OldLen) >= 0 do | |
2200 | Cont inueCode : = TRUE; | |
2201 | if Con tinueCode then | |
2202 | Scre enReaderSy stem_Conti nue; | |
2203 | end; | |
2204 | ||
2205 | procedur e Ctrl508W ork(ctrl: TControl); | |
2206 | var | |
2207 | lbl: T CPRSTempla teFieldLab el; | |
2208 | begin | |
2209 | if (Ct rl is TCPR STemplateF ieldLabel) and (not (Ctrl is T CPRSDialog HyperlinkL abel)) the n | |
2210 | begin | |
2211 | lbl := Ctrl as TCPRSTemp lateFieldL abel; | |
2212 | if t rim(lbl.Ca ption) <> '' then | |
2213 | begi n | |
2214 | Sc reenReader System_Cur rentLabel( lbl); | |
2215 | Sc reenReader System_Add Text(lbl.C aption); | |
2216 | end | |
2217 | else | |
2218 | begi n | |
2219 | lb l.TabStop := FALSE; | |
2220 | Sc reenReader System_Sto p; | |
2221 | end; | |
2222 | Add2 TabOrder(T WinControl (ctrl)); | |
2223 | end | |
2224 | else | |
2225 | begin | |
2226 | if c trl is TWi nControl t hen | |
2227 | Ad d2TabOrder (TWinContr ol(ctrl)); | |
2228 | if S upports(ct rl, ICPRSD ialogCompo nent) then | |
2229 | Sc reenReader System_Cur rentCompon ent(ctrl a s ICPRSDia logCompone nt); | |
2230 | end; | |
2231 | sLbl : = nil; | |
2232 | nLbl : = nil; | |
2233 | end; | |
2234 | ||
2235 | procedur e NextLine ; | |
2236 | begin | |
2237 | if(Max X < x) the n | |
2238 | MaxX := x; | |
2239 | x := F OCUS_RECT_ MARGIN; { leave two pixels on the left f or the Foc us Rect} | |
2240 | inc(y, yinc); | |
2241 | yinc : = ybase; | |
2242 | end; | |
2243 | ||
2244 | begin | |
2245 | MaxTextL en := MaxL en - (FOCU S_RECT_MAR GIN * 2);{ save room for the fo cus rectan gle on the panel} | |
2246 | if(FFirs tBuild or (FPanel.Wi dth <> Max Len)) then | |
2247 | begin | |
2248 | Init; | |
2249 | for i := 0 to FC ontrols.Co unt-1 do | |
2250 | begin | |
2251 | txt := FContro ls[i]; | |
2252 | if S creenReade rSystemAct ive then | |
2253 | Te xt508Work; | |
2254 | if S tripCode(t xt,EOL_MAR KER) then | |
2255 | begi n | |
2256 | if ((x <> 0) or LastLin eBlank) th en | |
2257 | NextLine; | |
2258 | La stLineBlan k := (txt = ''); | |
2259 | end; | |
2260 | if(t xt <> '') then | |
2261 | begi n | |
2262 | wh ile(txt <> '') do | |
2263 | be gin | |
2264 | cnt := Num CharsFitIn Width(FFon t.Handle, txt, MaxTe xtLen-x); | |
2265 | MaxChars : = cnt; | |
2266 | if(cnt >= length(txt )) then | |
2267 | begin | |
2268 | DoLabel( txt); | |
2269 | txt := ' '; | |
2270 | end | |
2271 | else | |
2272 | if(cnt < 1 ) then | |
2273 | NextLine | |
2274 | else | |
2275 | begin | |
2276 | repeat | |
2277 | if(txt [cnt+1] = ' ') then | |
2278 | begin | |
2279 | DoLa bel(copy(t xt,1,cnt)) ; | |
2280 | Next Line; | |
2281 | txt := copy(tx t, cnt + 1 , MaxInt); | |
2282 | brea k; | |
2283 | end | |
2284 | else | |
2285 | dec( cnt); | |
2286 | until(cn t = 0); | |
2287 | if(cnt = 0) then | |
2288 | begin | |
2289 | if(x = FOCUS_REC T_MARGIN) then {If x is at the far left margin...} | |
2290 | begin | |
2291 | DoLa bel(Copy(t xt,1,MaxCh ars)); | |
2292 | Next Line; | |
2293 | txt := copy(tx t, MaxChar s + 1, Max Int); | |
2294 | end | |
2295 | else | |
2296 | Next Line; | |
2297 | end; | |
2298 | end; | |
2299 | en d; | |
2300 | end | |
2301 | else | |
2302 | begi n | |
2303 | ct rl := TCon trol(FCont rols.Objec ts[i]); | |
2304 | if (assigned( ctrl)) the n | |
2305 | be gin | |
2306 | if ScreenR eaderSyste mActive th en | |
2307 | Ctrl508W ork(ctrl); | |
2308 | idx := FIn dents.Inde xOfObject( Ctrl); | |
2309 | if idx >= 0 then | |
2310 | ind := S trToIntDef (Piece(FIn dents[idx] , U, 1), 0 ) | |
2311 | else | |
2312 | ind := 0 ; | |
2313 | if(x > 0) then | |
2314 | begin | |
2315 | if (x < MaxLen) an d (Ctrl is TORCheckB ox) and (T ORCheckBox (Ctrl).Str ingData = NewLine) t hen | |
2316 | x := M axLen; | |
2317 | if((ctrl .Width + x + ind) > MaxLen) th en | |
2318 | NextLi ne; | |
2319 | end; | |
2320 | inc(x,ind) ; | |
2321 | Ctrl.Left := x; | |
2322 | Ctrl.Top : = y; | |
2323 | inc(x, Ctr l.Width + 4); | |
2324 | if yinc <= Ctrl.Heig ht then | |
2325 | yinc := Ctrl.Heigh t + 2; | |
2326 | if (x < Ma xLen) and ((Ctrl is TRichEdit) or | |
2327 | ((Ctrl is TLabel) and (pos( CRLF, TLab el(Ctrl).C aption) > 0))) then | |
2328 | x := Max Len; | |
2329 | en d; | |
2330 | end; | |
2331 | end; | |
2332 | NextLi ne; | |
2333 | FPanel .Height := (y-1) + ( FOCUS_RECT _MARGIN * 2); //AGP added Focu s_rect_mar gin for Re minder spa cing | |
2334 | FPanel .Width := MaxX + FOC US_RECT_MA RGIN; | |
2335 | end; | |
2336 | if(FFiel dValues <> '') then | |
2337 | SetFie ldValues(F FieldValue s); | |
2338 | if Scree nReaderSys temActive then | |
2339 | Screen ReaderSyst em_Stop; | |
2340 | Result : = FPanel; | |
2341 | end; | |
2342 | ||
2343 | function T TemplateDi alogEntry. GetText: s tring; | |
2344 | begin | |
2345 | Result : = ResolveT emplateFie lds(FText, FALSE); | |
2346 | end; | |
2347 | ||
2348 | procedure TTemplateD ialogEntry .KillLabel s; | |
2349 | var | |
2350 | i, idx: integer; | |
2351 | obj: TOb ject; | |
2352 | max: int eger; | |
2353 | ||
2354 | begin | |
2355 | if(assig ned(FPanel )) then | |
2356 | begin | |
2357 | max := FPanel.Co ntrolCount -1; | |
2358 | for i := max dow nto 0 do | |
2359 | begin | |
2360 | // deletin g TVA508St aticText c an delete several TV A508Chaine dLabel com ponents | |
2361 | if i < FPanel. ControlCou nt then | |
2362 | begi n | |
2363 | ob j := FPane l.Controls [i]; | |
2364 | if (not (obj is TVA508 ChainedLab el)) and | |
2365 | ((obj is TLabel) or (obj is T VA508Stati cText)) th en | |
2366 | be gin | |
2367 | idx := FCo ntrols.Ind exOfObject (obj); | |
2368 | if idx < 0 then | |
2369 | obj.Free ; | |
2370 | en d; | |
2371 | end; | |
2372 | end; | |
2373 | end; | |
2374 | end; | |
2375 | ||
2376 | procedure TTemplateD ialogEntry .SetAutoDe stroyOnPan elFree( | |
2377 | const Va lue: boole an); | |
2378 | var | |
2379 | M: TMeth od; | |
2380 | ||
2381 | begin | |
2382 | FAutoDes troyOnPane lFree := V alue; | |
2383 | if(Value ) then | |
2384 | begin | |
2385 | M.Data := Self; | |
2386 | M.Code := @Panel Destroy; | |
2387 | FPanel .OnDestroy := TNotif yEvent(M); | |
2388 | end | |
2389 | else | |
2390 | FPanel .OnDestroy := nil; | |
2391 | end; | |
2392 | ||
2393 | procedure TTemplateD ialogEntry .SetContro lText(Ctrl ID: intege r; AText: string); | |
2394 | var | |
2395 | cnt, i, j: integer ; | |
2396 | Ctrl: TC ontrol; | |
2397 | Done: bo olean; | |
2398 | ||
2399 | begin | |
2400 | FUpdatin g := TRUE; | |
2401 | try | |
2402 | Done : = FALSE; | |
2403 | cnt := 0; | |
2404 | for i := 0 to FC ontrols.Co unt-1 do | |
2405 | begin | |
2406 | Ctrl := TContr ol(FContro ls.Objects [i]); | |
2407 | if(a ssigned(Ct rl)) and ( Ctrl.Tag = CtrlID) t hen | |
2408 | begi n | |
2409 | Do ne := TRUE ; | |
2410 | if (Ctrl is T Label) the n | |
2411 | TLabel(Ctr l).Caption := AText | |
2412 | el se | |
2413 | if (Ctrl is T Edit) then | |
2414 | TEdit(Ctrl ).Text := AText | |
2415 | el se | |
2416 | if (Ctrl is T ORComboBox ) then | |
2417 | TORComboBo x(Ctrl).Se lectByID(A Text) | |
2418 | el se | |
2419 | if (Ctrl is T RichEdit) then | |
2420 | TRichEdit( Ctrl).Line s.Text := AText | |
2421 | el se | |
2422 | if (Ctrl is T ORDateComb o) then | |
2423 | TORDateCom bo(Ctrl).F MDate := M akeFMDateT ime(piece( AText,':', 2)) | |
2424 | el se | |
2425 | if (Ctrl is T ORDateBox) then | |
2426 | TORDateBox (Ctrl).Tex t := AText | |
2427 | el se | |
2428 | if (Ctrl is T ORCheckBox ) then | |
2429 | be gin | |
2430 | Done := FA LSE; | |
2431 | TORCheckBo x(Ctrl).Ch ecked := F ALSE; //<-PSI -06-170-AD DED THIS L INE - v27. 23 - RV | |
2432 | if(cnt = 0 ) then | |
2433 | cnt := D elimCount( AText, '|' ) + 1; | |
2434 | for j := 1 to cnt do | |
2435 | begin | |
2436 | if(TORCh eckBox(Ctr l).Caption = piece(A Text,'|',j )) then | |
2437 | TORChe ckBox(Ctrl ).Checked := TRUE; | |
2438 | end; | |
2439 | en d | |
2440 | el se | |
2441 | if (Ctrl is T fraTemplat eFieldButt on) then | |
2442 | TfraTempla teFieldBut ton(Ctrl). ButtonText := AText | |
2443 | el se | |
2444 | if (Ctrl is T Panel) the n | |
2445 | be gin | |
2446 | for j := 0 to Ctrl.C omponentCo unt-1 do | |
2447 | if Ctrl. Components [j] is TUp Down then | |
2448 | begin | |
2449 | TUpDow n(Ctrl.Com ponents[j] ).Position := StrToI ntDef(ATex t,0); | |
2450 | break; | |
2451 | end; | |
2452 | en d; | |
2453 | end; | |
2454 | if D one then b reak; | |
2455 | end; | |
2456 | finally | |
2457 | FUpdat ing := FAL SE; | |
2458 | end; | |
2459 | end; | |
2460 | ||
2461 | procedure TTemplateD ialogEntry .SetFieldV alues(cons t Value: s tring); | |
2462 | var | |
2463 | i: integ er; | |
2464 | TmpSL: T StringList ; | |
2465 | ||
2466 | begin | |
2467 | FFieldVa lues := Va lue; | |
2468 | TmpSL := TStringLi st.Create; | |
2469 | try | |
2470 | TmpSL. CommaText := Value; | |
2471 | for i := 0 to Tm pSL.Count- 1 do | |
2472 | SetC ontrolText (StrToIntD ef(Piece(T mpSL[i], U , 1), 0), Piece(TmpS L[i], U, 2 )); | |
2473 | finally | |
2474 | TmpSL. Free; | |
2475 | end; | |
2476 | end; | |
2477 | ||
2478 | function T TemplateDi alogEntry. StripCode( var txt: s tring; cod e: char): boolean; | |
2479 | var | |
2480 | p: integ er; | |
2481 | begin | |
2482 | p := pos (code, txt ); | |
2483 | Result : = (p > 0); | |
2484 | if Resul t then | |
2485 | begin | |
2486 | while p > 0 do | |
2487 | begin | |
2488 | dele te(txt, p, 1); | |
2489 | p := pos(code, txt); | |
2490 | end; | |
2491 | end; | |
2492 | end; | |
2493 | ||
2494 | procedure TTemplateD ialogEntry .UpDownCha nge(Sender : TObject) ; | |
2495 | begin | |
2496 | EnsureTe xt(TEdit(S ender), TU pDown(TEdi t(Sender). Tag)); | |
2497 | DoChange (Sender); | |
2498 | end; | |
2499 | ||
2500 | function S tripEmbedd ed(iItems: string): string; | |
2501 | {7/26/01 S Monson | |
2502 | Returns the field will all e mbedded fi elds remov ed} | |
2503 | var | |
2504 | p1, p2, icur: inte ger; | |
2505 | Begin | |
2506 | p1 := po s(Template FieldBegin Signature, iItems); | |
2507 | icur := 0; | |
2508 | while p1 > 0 do | |
2509 | begin | |
2510 | p2 : = pos(Temp lateFieldE ndSignatur e,copy(iIt ems,icur+p 1+Template FieldSigna tureLen,ma xint)); | |
2511 | if p2 > 0 the n | |
2512 | be gin | |
2513 | delete(iIt ems,p1+icu r,Template FieldSigna tureLen+p2 +TemplateF ieldSignat ureEndLen- 1); | |
2514 | icur := ic ur + p1 - 1; | |
2515 | p1 := pos( TemplateFi eldBeginSi gnature,co py(iItems, icur+1,max int)); | |
2516 | en d | |
2517 | else | |
2518 | p1 := 0; | |
2519 | end; | |
2520 | Result : = iItems; | |
2521 | end; | |
2522 | ||
2523 | procedure StripScree nReaderCod es(var Tex t: string) ; | |
2524 | var | |
2525 | p, j: in teger; | |
2526 | begin | |
2527 | for j := low(Scree nReaderCod es) to hig h(ScreenRe aderCodes) do | |
2528 | begin | |
2529 | p := 1 ; | |
2530 | while (p > 0) do | |
2531 | begin | |
2532 | p := posex(Scr eenReaderC odes[j], T ext, p); | |
2533 | if p > 0 then | |
2534 | de lete(Text, p, Screen ReaderCode Lens[j]); | |
2535 | end; | |
2536 | end; | |
2537 | end; | |
2538 | ||
2539 | procedure StripScree nReaderCod es(SL: TSt rings); | |
2540 | var | |
2541 | temp: st ring; | |
2542 | i: integ er; | |
2543 | ||
2544 | begin | |
2545 | for i := 0 to SL.C ount - 1 d o | |
2546 | begin | |
2547 | temp : = SL[i]; | |
2548 | StripS creenReade rCodes(tem p); | |
2549 | SL[i] := temp; | |
2550 | end; | |
2551 | end; | |
2552 | ||
2553 | function H asScreenRe aderBreakC odes(SL: T Strings): boolean; | |
2554 | var | |
2555 | i: integ er; | |
2556 | ||
2557 | begin | |
2558 | Result : = TRUE; | |
2559 | for i := 0 to SL.C ount - 1 d o | |
2560 | begin | |
2561 | if pos (ScreenRea derCodeSig nature, SL [i]) > 0 t hen | |
2562 | exit ; | |
2563 | end; | |
2564 | Result : = FALSE; | |
2565 | end; | |
2566 | ||
2567 | initializa tion | |
2568 | ||
2569 | finalizati on | |
2570 | KillObj( @uTmplFlds , TRUE); | |
2571 | KillObj( @uEntries, TRUE); | |
2572 | ||
2573 | end. |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.