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