source: cprs/branches/tmg-cprs/CPRS-Chart/Templates/uTemplateFields.pas@ 834

Last change on this file since 834 was 736, checked in by Kevin Toppenberg, 15 years ago

Bug fixes
File size: 96.4 KB
RevLine 
[453]1//kt -- Modified with SourceScanner on 8/8/2007
2unit uTemplateFields;
3
4interface
5
6uses
[694]7 Forms, SysUtils, StrUtils, Classes, Dialogs, StdCtrls, ExtCtrls, Controls, Contnrs,
[729]8 Graphics, ORClasses, ComCtrls, ORDtTm, uEvaluate;
[453]9
10type
11 TTemplateFieldType = (dftUnknown, dftEditBox, dftComboBox, dftButton, dftCheckBoxes,
12 dftRadioButtons, dftDate, dftNumber, dftHyperlink, dftWP, dftText);
13
14 TTmplFldDateType = (dtUnknown, dtDate, dtDateTime, dtDateReqTime,
15 dtCombo, dtYear, dtYearMonth);
16
17const
18 FldItemTypes = [dftComboBox, dftButton, dftCheckBoxes, dftRadioButtons, dftWP, dftText];
19 SepLinesTypes = [dftCheckBoxes, dftRadioButtons];
20 EditLenTypes = [dftEditBox, dftComboBox, dftWP];
21 EditDfltTypes = [dftEditBox, dftHyperlink];
22 EditDfltType2 = [dftEditBox, dftHyperlink, dftDate];
23 ItemDfltTypes = [dftComboBox, dftButton, dftCheckBoxes, dftRadioButtons];
24 NoRequired = [dftHyperlink, dftText];
25 ExcludeText = [dftHyperlink, dftText];
26 DateComboTypes = [dtCombo, dtYear, dtYearMonth];
27
28type
29 TTemplateDialogEntry = class(TObject)
30 private
31 FID: string;
32 FFont: TFont;
33 FPanel: TPanel;
34 FControls: TStringList;
35 FIndents: TStringList;
36 FFirstBuild: boolean;
37 FOnChange: TNotifyEvent;
38 FText: string;
39 FInternalID: string;
40 FObj: TObject;
41 FFieldValues: string;
42 FUpdating: boolean;
43 FAutoDestroyOnPanelFree: boolean;
44 FPanelDying: boolean;
45 FOnDestroy: TNotifyEvent;
[654]46 FHTMLMode : boolean; //kt added 12/28/09
47 FAnswerOpenTag : string; //kt added 12/28/09
48 FAnswerCloseTag : string; //kt added 12/28/09
[453]49 procedure KillLabels;
50 function GetFieldValues: string;
51 procedure SetFieldValues(const Value: string);
52 procedure SetAutoDestroyOnPanelFree(const Value: boolean);
[654]53 procedure SetAnswerHTMLTag(Value : string); //kt 12/28/09
54
[453]55 protected
56 procedure UpDownChange(Sender: TObject);
57 procedure DoChange(Sender: TObject);
58 function GetControlText(CtrlID: integer; NoCommas: boolean;
59 var FoundEntry: boolean; AutoWrap: boolean;
60 emField: string = ''): string;
61 procedure SetControlText(CtrlID: integer; AText: string);
62 public
63 constructor Create(AParent: TWinControl; AID, Text: string);
64 destructor Destroy; override;
65 function GetPanel(MaxLen: integer; AParent: TWinControl): TPanel;
66 function GetText: string;
67 property Text: string read FText write FText;
68 property InternalID: string read FInternalID write FInternalID;
69 property ID: string read FID;
70 property Obj: TObject read FObj write FObj;
71 property OnChange: TNotifyEvent read FOnChange write FOnChange;
72 property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
73 property FieldValues: string read GetFieldValues write SetFieldValues;
[654]74 property HTMLMode : boolean read FHTMLMode write FHTMLMode; //kt added 12/28/09
75 property AnswerHTMLTag : string read FAnswerOpenTag write SetAnswerHTMLTag; //kt added 12/28/09
[453]76 property AutoDestroyOnPanelFree: boolean read FAutoDestroyOnPanelFree
77 write SetAutoDestroyOnPanelFree;
78 end;
79
80 TTemplateField = class(TObject)
81 private
82 FMaxLen: integer;
83 FFldName: string;
84 FNameChanged: boolean;
85 FLMText: string;
86 FEditDefault: string;
87 FNotes: string;
88 FItems: string;
89 FInactive: boolean;
90 FItemDefault: string;
91 FFldType: TTemplateFieldType;
92 FRequired: boolean;
93 FSepLines: boolean;
94 FTextLen: integer;
95 FIndent: integer;
96 FPad: integer;
97 FMinVal: integer;
98 FMaxVal: integer;
99 FIncrement: integer;
100 FURL: string;
101 FDateType: TTmplFldDateType;
102 FModified: boolean;
103 FID: string;
104 FLocked: boolean;
105 procedure SetEditDefault(const Value: string);
106 procedure SetFldName(const Value: string);
107 procedure SetFldType(const Value: TTemplateFieldType);
108 procedure SetInactive(const Value: boolean);
109 procedure SetRequired(const Value: boolean);
110 procedure SetSepLines(const Value: boolean);
111 procedure SetItemDefault(const Value: string);
112 procedure SetItems(const Value: string);
113 procedure SetLMText(const Value: string);
114 procedure SetMaxLen(const Value: integer);
115 procedure SetNotes(const Value: string);
116 procedure SetID(const Value: string);
117 procedure SetIncrement(const Value: integer);
118 procedure SetIndent(const Value: integer);
119 procedure SetMaxVal(const Value: integer);
120 procedure SetMinVal(const Value: integer);
121 procedure SetPad(const Value: integer);
122 procedure SetTextLen(const Value: integer);
123 procedure SetURL(const Value: string);
124 function GetTemplateFieldDefault: string;
125 procedure CreateDialogControls(Entry: TTemplateDialogEntry;
126 var Index: Integer; CtrlID: integer);
127 function SaveError: string;
128 function Width: integer;
129 function GetRequired: boolean;
130 procedure SetDateType(const Value: TTmplFldDateType);
131 public
132 constructor Create(AData: TStrings);
133 destructor Destroy; override;
134 procedure Assign(AFld: TTemplateField);
135 function NewField: boolean;
136 function CanModify: boolean;
137 property ID: string read FID write SetID;
138 property FldName: string read FFldName write SetFldName;
139 property NameChanged: boolean read FNameChanged;
140 property FldType: TTemplateFieldType read FFldType write SetFldType;
141 property MaxLen: integer read FMaxLen write SetMaxLen;
142 property EditDefault: string read FEditDefault write SetEditDefault;
143 property Items: string read FItems write SetItems;
144 property ItemDefault: string read FItemDefault write SetItemDefault;
145 property LMText: string read FLMText write SetLMText;
146 property Inactive: boolean read FInactive write SetInactive;
147 property Required: boolean read GetRequired write SetRequired;
148 property SepLines: boolean read FSepLines write SetSepLines;
149 property TextLen: integer read FTextLen write SetTextLen;
150 property Indent: integer read FIndent write SetIndent;
151 property Pad: integer read FPad write SetPad;
152 property MinVal: integer read FMinVal write SetMinVal;
153 property MaxVal: integer read FMaxVal write SetMaxVal;
154 property Increment: integer read FIncrement write SetIncrement;
155 property URL: string read FURL write SetURL;
156 property DateType: TTmplFldDateType read FDateType write SetDateType;
157 property Notes: string read FNotes write SetNotes;
158 property TemplateFieldDefault: string read GetTemplateFieldDefault;
159 end;
160
161 TIntStruc = class(TObject)
162 public
163 x: integer;
164 end;
165
166function GetDialogEntry(AParent: TWinControl; AID, AText: string): TTemplateDialogEntry;
167procedure FreeEntries(SL: TStrings);
[729]168//kt 3/26/10 --> original procedure AssignFieldIDs(var Txt: string); overload;
169procedure AssignFieldIDs(var Txt: string; NameToObjID : TStringList=nil); overload; //kt 3/26/10
170//kt 3/26/10 --> original procedure AssignFieldIDs(SL: TStrings); overload;
171procedure AssignFieldIDs(SL: TStrings; NameToObjID : TStringList=nil); overload; //kt 3/26/10
172procedure HideFormulas(SL : TStrings; Formulas : TStringList); //kt added 3/26/10
173procedure HideTxtObjects(SL : TStrings; TxtObjects : TStringList); //kt added 3/28/10
174//function RestoreTransformFormulas(var Txt : string; Formulas, NameToObjID : TStringList) : boolean; overload; //kt added 3/26/10
175function RestoreTransformFormulas(SL : TStrings; Formulas, NameToObjID : TStringList) : boolean; {overload; }//kt added 3/26/10
[654]176//kt 12/28/09 originial --> function ResolveTemplateFields(Text: string; AutoWrap: boolean; Hidden: boolean = FALSE; IncludeEmbedded: boolean = FALSE): string;
[729]177function RestoreTransformTxtObjects(SL : TStrings; TxtObjects, NameToObjID : TStringList) : boolean;
[654]178function ResolveTemplateFields(Text: string;
179 AutoWrap: boolean;
180 Hidden: boolean = FALSE;
181 IncludeEmbedded: boolean = FALSE;
182 HTMLMode : boolean = FALSE; //kt added 12/28/09
183 HTMLAnswerOpenTag : string = ''; //kt added 12/28/09
184 HTMLAnswerCloseTag : string = '' //kt added 12/28/09
185 ): string;
[453]186function AreTemplateFieldsRequired(const Text: string; FldValues: TORStringList = nil): boolean;
187function HasTemplateField(txt: string): boolean;
188
189function GetTemplateField(ATemplateField: string; ByIEN: boolean): TTemplateField;
190function TemplateFieldNameProblem(Fld: TTemplateField): boolean;
191function SaveTemplateFieldErrors: string;
192procedure ClearModifiedTemplateFields;
193function AnyTemplateFieldsModified: boolean;
194procedure ListTemplateFields(const AText: string; AList: TStrings; ListErrors: boolean = FALSE);
195function BoilerplateTemplateFieldsOK(const AText: string; Msg: string = ''): boolean;
196procedure EnsureText(edt: TEdit; ud: TUpDown);
197procedure ConvertCodes2Text(sl: TStrings; Short: boolean);
198function StripEmbedded(iItems: string): string;
[729]199function CloseCharPos(OpenChar, CloseChar : char; var Txt : string; StartingPos : integer=1) : integer; //kt added
[735]200function FormatFormula(test: string): string; //elh 04/09/10
[453]201
[729]202type
203 TMGExtension = (tmgeFN,tmgeOBJ);
204 TMGExtMatch = record
205 Signature : string;
206 SigLen : integer;
207 EndTag : char;
208 end;
209 TMGExtArray = array[tmgeFN..tmgeOBJ] of TMGExtMatch;
210
[453]211const
212 TemplateFieldBeginSignature = '{FLD:';
213 TemplateFieldEndSignature = '}';
[729]214 HTML_BEGIN_TAG = '{HTML:'; //kt
215 HTML_ENDING_TAG = '}'; //kt
216 HTML_BEGIN_TAGLEN = length(HTML_BEGIN_TAG); //kt
217 HTML_ENDING_TAGLEN = length(HTML_ENDING_TAG); //kt
218 FN_BEGIN_SIGNATURE = '{FN:'; //kt
219 FN_BEGIN_TAG = '{'; //kt
220 FN_END_TAG = '}'; //kt
221 FN_BEGIN_SIGNATURE_LEN = length(FN_BEGIN_SIGNATURE);//kt
222 FN_END_TAGLEN = length(FN_END_TAG); //kt
223 FN_SHOW_TEXT = '{%_____%-#'; //kt
224 FN_SHOW_TEXT_END = '}'; //kt
225 FN_SHOW_TEXT_LEN = length(FN_SHOW_TEXT); //kt
226 FN_SHOW_TEXT_END_LEN = length(FN_SHOW_TEXT_END);//kt
227 FN_FIELD_TAG = '[FLD:'; //kt
228 FN_FIELD_TAG_LEN = length(FN_FIELD_TAG); //kt
229 FN_OBJ_TAG = '[OBJ:'; //kt
230 FN_OBJ_TAG_LEN = length(FN_OBJ_TAG); //kt
231 FLD_OBJ_SIGNATURE = '{OBJ:'; //kt
232 FLD_OBJ_END_TAG = '}'; //kt
233 FLD_OBJ_SIG_LEN = length(FLD_OBJ_SIGNATURE); //kt
234 OBJ_SHOW_TEXT = '{OBJ%_____%-#'; //kt
235 OBJ_SHOW_TEXT_END = '}'; //kt
236 OBJ_SHOW_TEXT_LEN = length(OBJ_SHOW_TEXT); //kt
237 TMG_MATCH : TMGExtArray =
238 ( (Signature : FN_BEGIN_SIGNATURE;
239 SigLen : FN_BEGIN_SIGNATURE_LEN;
240 EndTag : FN_END_TAG),
241
242 (Signature : FLD_OBJ_SIGNATURE;
243 SigLen : FLD_OBJ_SIG_LEN;
244 EndTag : FLD_OBJ_END_TAG)
245 );
246
247
[453]248 //MissingFieldsTxt = 'One or more required fields must still be entered.'; <-- original line. //kt 8/8/2007
249 function MissingFieldsTxt : string; //kt added
250
251Const
252 TemplateFieldTypeCodes: array[TTemplateFieldType] of string[1] =
253 { dftUnknown } ('',
254 { dftEditBox } 'E',
255 { dftComboBox } 'C',
256 { dftButton } 'B',
257 { dftCheckBoxes } 'X',
258 { dftRadioButtons } 'R',
259 { dftDate } 'D',
260 { dftNumber } 'N',
261 { dftHyperlink } 'H',
262 { dftWP } 'W',
263 { dftText } 'T');
264
265function TemplateFieldTypeDesc(index: TTemplateFieldType; short : boolean) : string;
266(* //kt replaced with function below
267 TemplateFieldTypeDesc: array[TTemplateFieldType, boolean] of string =
268 { dftUnknown } (('',''),
269 { dftEditBox } ('Edit Box', 'Edit'),
270 { dftComboBox } ('Combo Box', 'Combo'),
271 { dftButton } ('Button', 'Button'),
272 { dftCheckBoxes } ('Check Boxes', 'Check'),
273 { dftRadioButtons } ('Radio Buttons', 'Radio'),
274 { dftDate } ('Date', 'Date'),
275 { dftNumber } ('Number', 'Num'),
276 { dftHyperlink } ('Hyperlink', 'Link'),
277 { dftWP } ('Word Processing','WP'),
278 { dftWP } ('Display Text', 'Text'));
279*)
280
281function TemplateDateTypeDesc(index: TTmplFldDateType; Short : boolean) : string;
282(* //kt replaced with function below
283 TemplateDateTypeDesc: array[TTmplFldDateType, boolean] of string =
284 { dtUnknown } (('',''),
285// { dtDate } ('Date', 'Date'), <-- original line. //kt 8/8/2007
286// { dtDateTime } ('Date & Time', 'Time'), <-- original line. //kt 8/8/2007
287// { dtDateReqTime } ('Date & Req Time','R.Time'), <-- original line. //kt 8/8/2007
288// { dtCombo } ('Date Combo', 'C.Date'), <-- original line. //kt 8/8/2007
289// { dtYear } ('Year', 'Year'), <-- original line. //kt 8/8/2007
290// { dtYearMonth } ('Year & Month', 'Month')); <-- original line. //kt 8/8/2007
291*)
292
293Const
294 FldNames: array[TTemplateFieldType] of string =
295 { dftUnknown } ('',
296 { dftEditBox } 'EDIT',
297 { dftComboBox } 'LIST',
298 { dftButton } 'BTTN',
299 { dftCheckBoxes } 'CBOX',
300 { dftRadioButtons } 'RBTN',
301 { dftDate } 'DATE',
302 { dftNumber } 'NUMB',
303 { dftHyperlink } 'LINK',
304 { dftWP } 'WRDP',
305 { dftTExt } 'TEXT');
306
307 TemplateFieldDateCodes: array[TTmplFldDateType] of string[1] =
308 { dtUnknown } ('',
309 { dtDate } 'D',
310 { dtDateTime } 'T',
311 { dtDateReqTime } 'R',
312 { dtCombo } 'C',
313 { dtYear } 'Y',
314 { dtYearMonth } 'M');
315
316 MaxTFWPLines = 20;
317 MaxTFEdtLen = 70;
318
319type
320 TFieldPanel = class(TPanel) {This is the panel associated with the child}
321 private {dialog checkboxes in reminders dialogs}
322 FOnDestroy: TNotifyEvent;
323 FCanvas: TControlCanvas; {used to draw focus rect}
324 function GetFocus: boolean;
325 procedure SetTheFocus(const Value: boolean);
326 protected {used to draw focus rect}
327 procedure Paint; override; {used to draw focus rect}
328 public
329 destructor Destroy; override;
330 property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
331 property Focus: boolean read GetFocus write SetTheFocus; {to draw focus rect}
332 property OnKeyPress; {to click the checkbox when spacebar is pressed}
333 end;
334
335implementation
336
337uses
338 ORFn, rTemplates, ORCtrls, mTemplateFieldButton, dShared, uConst, uCore, rCore, Windows,
[729]339 ORNet, //kt
340 TRPCB, //kt
[453]341 DKLang; //kt
342
343const
344 NewTemplateField = 'NEW TEMPLATE FIELD';
345 TemplateFieldSignatureLen = length(TemplateFieldBeginSignature);
346 TemplateFieldSignatureEndLen = length(TemplateFieldEndSignature);
347
348var
349 uTmplFlds: TList = nil;
350 uEntries: TStringList = nil;
351
352 uNewTemplateFieldIDCnt: longint = 0;
353 uRadioGroupIndex: integer = 0;
354
355 uInternalFieldIDCount: integer = 0;
[729]356 uInternalFormulaCount: integer = 0; //kt
357 uInternalTxtObjCount : integer = 0; //kt
[453]358
359const
360 FieldIDDelim = '`';
361 FieldIDLen = 6;
362 NewLine = 'NL';
363
364type
365 TFieldLabel = class(TLabel)
366 private
367 FExclude: boolean;
368 public
369 property Exclude: boolean read FExclude;
370 end;
371
372 TWebLabel = class(TFieldLabel)
373 private
374 FAddr: string;
375 procedure Clicked(Sender: TObject);
376 public
377 procedure Init(Addr: string);
378 end;
379
380function MissingFieldsTxt : string;
381begin Result := DKLangConstW('uTemplateFields_One_or_more_required_fields_must_still_be_enteredx');
382end;
383
384//kt 8-17-07 Added to replace constant with function
385function TemplateFieldTypeDesc(index: TTemplateFieldType; Short : boolean) : string;
386begin
387 Result := '';
388 case index of
389 dftUnknown : Result := '';
390 dftEditBox : if not Short then Result := DKLangConstW('uTemplateFields_Edit_Box') else Result := DKLangConstW('uTemplateFields_Edit');
391 dftComboBox : if not Short then Result := DKLangConstW('uTemplateFields_Combo_Box') else Result := DKLangConstW('uTemplateFields_Combo');
392 dftButton : if not Short then Result := DKLangConstW('uTemplateFields_Button') else Result := DKLangConstW('uTemplateFields_Button');
393 dftCheckBoxes : if not Short then Result := DKLangConstW('uTemplateFields_Check_Boxes') else Result := DKLangConstW('uTemplateFields_Check');
394 dftRadioButtons : if not Short then Result := DKLangConstW('uTemplateFields_Radio_Buttons') else Result := DKLangConstW('uTemplateFields_Radio');
395 dftDate : if not Short then Result := DKLangConstW('uTemplateFields_Date') else Result := DKLangConstW('uTemplateFields_Date');
396 dftNumber : if not Short then Result := DKLangConstW('uTemplateFields_Number') else Result := DKLangConstW('uTemplateFields_Num');
397 dftHyperlink : if not Short then Result := DKLangConstW('uTemplateFields_Hyperlink') else Result := DKLangConstW('uTemplateFields_Link');
398 dftWP : if not Short then Result := DKLangConstW('uTemplateFields_Word_Processing') else Result := DKLangConstW('uTemplateFields_WP');
399 dftText : if not Short then Result := DKLangConstW('uTemplateFields_Display_Text') else Result := DKLangConstW('uTemplateFields_Text');
400 end; {case}
401end;
402
403//kt 8-17-07 Added to replace constant with function
404function TemplateDateTypeDesc(index: TTmplFldDateType; Short : boolean) : string;
405begin
406 Result := '';
407 case index of
408 dtUnknown : Result := '';
409 dtDate : if not Short then Result := DKLangConstW('uTemplateFields_Date') else Result := DKLangConstW('uTemplateFields_Date');
410 dtDateTime : if not Short then Result := DKLangConstW('uTemplateFields_Date_x_Time') else Result := DKLangConstW('uTemplateFields_Time');
411 dtDateReqTime : if not Short then Result := DKLangConstW('uTemplateFields_Date_x_Req_Time') else Result := DKLangConstW('uTemplateFields_RxTime');
412 dtCombo : if not Short then Result := DKLangConstW('uTemplateFields_Date_Combo') else Result := DKLangConstW('uTemplateFields_CxDate');
413 dtYear : if not Short then Result := DKLangConstW('uTemplateFields_Year') else Result := DKLangConstW('uTemplateFields_Year');
414 dtYearMonth : if not Short then Result := DKLangConstW('uTemplateFields_Year_x_Month') else Result := DKLangConstW('uTemplateFields_Month');
415 end; {case}
416end;
417
418function GetNewFieldID: string;
419begin
420 inc(uInternalFieldIDCount);
421 Result := IntToStr(uInternalFieldIDCount);
422 Result := FieldIDDelim +
423 copy(StringOfChar('0', FieldIDLen-2) + Result, length(Result), FieldIDLen-1);
424end;
425
426function GetDialogEntry(AParent: TWinControl; AID, AText: string): TTemplateDialogEntry;
427var
428 idx: integer;
429
430begin
431 Result := nil;
432 if AID = '' then exit;
433 if(not assigned(uEntries)) then
434 uEntries := TStringList.Create;
435 idx := uEntries.IndexOf(AID);
436 if(idx < 0) then
437 begin
438 Result := TTemplateDialogEntry.Create(AParent, AID, AText);
439 uEntries.AddObject(AID, Result);
440 end
441 else
442 Result := TTemplateDialogEntry(uEntries.Objects[idx]);
443end;
444
445procedure FreeEntries(SL: TStrings);
446var
447 i, idx, cnt: integer;
448
449begin
450 if(assigned(uEntries)) then
451 begin
452 for i := SL.Count-1 downto 0 do
453 begin
454 idx := uEntries.IndexOf(SL[i]);
455 if(idx >= 0) then
456 begin
457 cnt := uEntries.Count;
458 if(assigned(uEntries.Objects[idx])) then
459 begin
460 TTemplateDialogEntry(uEntries.Objects[idx]).AutoDestroyOnPanelFree := FALSE;
461 uEntries.Objects[idx].Free;
462 end;
463 if cnt = uEntries.Count then
464 uEntries.Delete(idx);
465 end;
466 end;
467 if(uEntries.Count = 0) then
468 uInternalFieldIDCount := 0;
[729]469 uInternalFormulaCount := 0; //kt
470 uInternalTxtObjCount := 0; //kt
[453]471 end;
472end;
473
[729]474//kt original line --> procedure AssignFieldIDs(var Txt: string);
475procedure AssignFieldIDs(var Txt: string; NameToObjID : TStringList); //kt
[453]476var
477 i: integer;
[729]478 p2 : integer; //kt
479 FldName : string; //kt
480 FldID : string; //kt
[453]481
482begin
483 i := 0;
[729]484 while (i < length(Txt)) do begin
[453]485 inc(i);
[729]486 if copy(Txt,i,TemplateFieldSignatureLen) = TemplateFieldBeginSignature then begin
[453]487 inc(i,TemplateFieldSignatureLen);
[729]488 if(i < length(Txt)) and (copy(Txt,i,1) <> FieldIDDelim) then begin
489 p2 := PosEx(TemplateFieldEndSignature,Txt,i); //kt
490 FldName := ''; //kt
491 if p2 > 0 then FldName := Trim(copy(Txt,i,(p2-i))); //kt
[453]492 insert(GetNewFieldID, Txt, i);
493 inc(i, FieldIDLen);
[729]494 if (FldName <> '') and Assigned(NameToObjID) then begin //kt
495 NameToObjID.AddObject(FldName,Pointer(uInternalFieldIDCount)); //kt
496 end; //kt
[453]497 end;
498 end;
499 end;
500end;
501
[729]502procedure AssignFieldIDs(SL: TStrings; NameToObjID : TStringList);
[453]503var
504 i: integer;
505 txt: string;
506
507begin
508 for i := 0 to SL.Count-1 do
509 begin
510 txt := SL[i];
[729]511 //kt AssignFieldIDs(txt);
512 AssignFieldIDs(txt, NameToObjID); //kt
[453]513 SL[i] := txt;
514 end;
515end;
516
[729]517function CloseCharPos(OpenChar, CloseChar : char; var Txt : string; StartingPos : integer=1) : integer;
518//kt added function
519//Return the position of a closing character, ignoring all intervening nested open and close chars
520//NOTE: It is expected that StartingPos is pointing to the first opening character.
521var i : integer;
522 CloseMatchesNeeded : integer;
523begin
524 Result := 0;
525 CloseMatchesNeeded := 1;
526 for i := StartingPos to Length(Txt) do begin
527 if (Txt[i] = OpenChar) and (i <> StartingPos) then Inc(CloseMatchesNeeded);
528 if Txt[i] = CloseChar then Dec(CloseMatchesNeeded);
529 if CloseMatchesNeeded = 0 then begin
530 Result := i;
531 break;
532 end;
533 end;
534end;
535
536
537procedure HideFormulas(SL : TStrings; Formulas : TStringList);
538//kt added function
539//NOTE: formulas will not be allowed to use the '}' character
540var p1,p2 : integer;
541 FnStr : string;
542 SubStrA,SubStrB : string;
543 Txt : String;
544begin
545 Txt := SL.Text;
546 p1 := Pos(FN_BEGIN_SIGNATURE,Txt);
547 while (p1>0) do begin
548 SubStrA := MidStr(Txt,1,p1-1);
549 p1 := p1 + FN_BEGIN_SIGNATURE_LEN;
550 //p2 := PosEx(FN_END_TAG,Txt,p1);
551 p2 := CloseCharPos(FN_BEGIN_TAG, FN_END_TAG, Txt, p1);
[736]552 SubStrB := MidStr(Txt,p2+1,StrLen(PChar(Txt))+1); //Changed from 999 to StrLen(PChar(Txt))+1. Some characters were getting lost including the dialog tags that trigger the dialog box elh 04/08/10
[729]553 FnStr := MidStr(Txt,p1, (p2-p1));
554 FnStr := AnsiReplaceText(FnStr,#9,'');
555 FnStr := AnsiReplaceText(FnStr,#10,'');
556 FnStr := AnsiReplaceText(FnStr,#13,'');
557 //FnStr := AnsiReplaceText(FnStr,' ','');
558 inc(uInternalFormulaCount);
559 Formulas.AddObject(FnStr,Pointer(uInternalFormulaCount));
560 Txt := SubStrA + FN_SHOW_TEXT + IntToStr(uInternalFormulaCount) + FN_SHOW_TEXT_END + SubStrB;
561 p1 := PosEx(FN_BEGIN_SIGNATURE,Txt,p1);
562 end;
563 SL.Text := Txt;
564end;
565
566procedure HideTxtObjects(SL : TStrings; TxtObjects : TStringList); //kt added 3/28/10
567//kt added function
568var p1,p2 : integer;
569 FnStr : string;
570 SubStrA,SubStrB : string;
571 Txt : String;
572begin
573 Txt := SL.Text;
574 p1 := Pos(FLD_OBJ_SIGNATURE,Txt);
575 while (p1>0) do begin
576 SubStrA := MidStr(Txt,1,p1-1);
577 p1 := p1 + FN_OBJ_TAG_LEN;
578 p2 := CloseCharPos(FN_BEGIN_TAG, FN_END_TAG, Txt, p1);
[736]579 SubStrB := MidStr(Txt,p2+1,StrLen(PChar(Txt))+1); //Changed from 999 to StrLen(PChar(Txt))+1. Some characters were getting lost including the dialog tags that trigger the dialog box elh 04/13/10
[729]580 FnStr := MidStr(Txt,p1, (p2-p1));
581 FnStr := AnsiReplaceText(FnStr,#9,'');
582 FnStr := AnsiReplaceText(FnStr,#10,'');
583 FnStr := AnsiReplaceText(FnStr,#13,'');
584 inc(uInternalTxtObjCount);
585 TxtObjects.AddObject(FnStr,Pointer(uInternalTxtObjCount));
586 Txt := SubStrA + OBJ_SHOW_TEXT + IntToStr(uInternalTxtObjCount) + OBJ_SHOW_TEXT_END + SubStrB;
587 p1 := PosEx(FLD_OBJ_SIGNATURE,Txt,p1);
588 end;
589 SL.Text := Txt;
590end;
591
592function InsideMarkers(var S : string; MarkerCh : char; P : integer) : boolean;
593//Function returns if position P is inside characters MarkerCh.
594//e.g. S = 'xxx|xxxxx|xxxxx' MarkerCh='|'
595// P = 2 ==> result is false
596// P = 5 ==> result is true
597// P = 12 ==> result is false
598
599var p1,p2 : integer;
600 Inside : boolean;
601begin
602 Inside := false;
603 p1 := Pos(MarkerCh,S);
604 while (p1 > 0) do begin
605 if (p1 >= P) then break;
606 p1 := PosEx(MarkerCh,S,p1+1);
607 if (p1 > 0) and (p1 > P) then Inside := not Inside;
608 end;
609 Result := Inside;
610end;
611
612function SubstuteIDs(Txt : string; NameToObjID : TStringList) : string;
613//kt added function
614//Prefix any field names with their FldID's, in format of FieldIDDelim+FldID
615// E.g. [FLD:1:NUM1-16] --> `00001NUM1-16`
616//Note: Field ID's are started with character FieldIDDelim, and are of a fixed length (FieldIDLen)
617
618(* Syntax examples:
619
620 {FN:[FLD:1:NUMB1-16]-[FLD:2:NUMB1-16]-[FLD:3:NUMB1-16]}, or
621 {FN:[OBJ:TABLE1]-[FLD:2:NUMB1-16]-[FLD:3:NUMB1-16]}, or
622 {FN:[OBJ:TABLE2("POTASSIUM")]-[FLD:2:NUMB1-16]-[FLD:3:NUMB1-16]}, or
623 {FN:[OBJ:TABLE2([FLD:1:NUMB1-16])]-[FLD:2:NUMB1-16]-[FLD:3:NUMB1-16]}
624 {FN:[OBJ:TABLE2((5+3)/2)]-[FLD:2:NUMB1-16]-[FLD:3:NUMB1-16]}
625 (arbitrary deep nesting)
626 Note: arguments should be round by matching [ ]'s
627 An argument will start with a TYPE (so far, FLD or OBJ) and ':'
628
629 If TYPE is FLD, there will be :number:, with number being same
630 as number in old format (i.e. ...]#2).
631 If number not provided, then default value is 1
632
633 If TYPE is OBJ, then this indicates that the parameter name (e.g. TABLE) is
634 the name of a TIU TEXT object, that will be processed on the server.
635 Parameters should be resolved before passing to the server.
636*)
637
638var i,j,p1,p2 : integer;
639 SubStrA,SubStrB, NumStr : string;
640 FldIDNum,CountofSimilar : integer;
641 FldIDNumStr : string;
642 CountOfSimStr : string;
643 Temp,FldName : string;
644 Skip : boolean;
645begin
646 for i := 0 to NameToObjID.Count-1 do begin
647 CountofSimilar := 0;
648 FldName := NameToObjID.Strings[i];
649 for j := 0 to i do begin
[735]650 if NameToObjID.Strings[j] = FldName then inc(CountofSimilar); //Changed from i to j elh 04/08/10
[729]651 end;
652 CountOfSimStr := IntToStr(CountofSimilar);
653 FldIDNum := Integer(NameToObjID.Objects[i]);
654 FldIDNumStr := IntToStr(FldIDNum);
655 FldIDNumStr := FieldIDDelim + StringOfChar('0', FieldIDLen-1-Length(FldIDNumStr)) + FldIDNumStr;
656 p1 := 1;
657 p1 := PosEx(FldName,Txt,p1);
658 while InsideMarkers(Txt, FieldIDDelim, p1) do begin //Ignore included fieldnames from prior cycle.
659 p2 := PosEx(FieldIDDelim,Txt,p1+1);
660 if p2 >0 then begin
661 p1 := p2+1;
662 p1 := PosEx(FldName,Txt,p1);
663 end else p1 := 999; //error condition.
664 end;
665 while (p1>0) and (p1 < 999) do begin
666 Skip := false;
667 SubStrA := MidStr(Txt,1,p1-1);
668 SubStrB := MidStr(Txt, p1+Length(FldName), 999);
669 if (LeftStr(SubStrB,1)=']') and (Pos(FN_FIELD_TAG,SubStrA) > 0) then begin
670 NumStr := piece(RightStr(SubStrA,7),':',2);
671 SubStrA := LeftStr(SubStrA,Length(SubStrA)-7);
672 p2 := 2;
673 SubStrB := MidStr(SubStrB,p2,999);
674 if NumStr <> CountOfSimStr then begin
675 Skip := true;
676 Inc(p1);
677 end;
678 end else begin
679 Skip := true;
680 Inc(p1);
681 end;
682 if not Skip then begin
683 Txt := SubStrA + FldIDNumStr +FldName + FieldIDDelim;
684 p1 := Length(Txt);
685 Txt := Txt + SubStrB;
686 end;
687 p1 := PosEx(FldName,Txt,p1);
688 end;
689 end;
690 Result := Txt;
691end;
692
693
694function RestoreTransformFormulas(SL : TStrings; Formulas, NameToObjID : TStringList) : boolean;
695//kt added 3/26/10
696//Returns if any changes made
697//Replace formula text back in, and change field names into FldID's
698
699 function GetFormula(NumStr : string) : string;
700 //Return formula text based on provided index number of formula
701 var num, i : integer;
702 PtrNum : Pointer;
703 begin
704 Result := '';
705 try
706 Num := StrToInt(NumStr);
707 PtrNum := Pointer(Num);
708 for i := 0 to Formulas.Count-1 do begin
709 if Formulas.Objects[i] = PtrNum then begin
710 Result := Formulas.Strings[i];
711 break;
712 end;
713 end;
714 except
715 on EConvertError do Result := '??';
716 end;
717 end;
718
719var p1,p2 : integer;
720 count : integer;
721 FnStr : string;
722 Txt : string;
723 SubStrA,SubStrB : string;
724begin
725 Txt := SL.Text;
726 Result := false;
727 p1 := Pos(FN_SHOW_TEXT,Txt);
728 while (p1>0) do begin
729 SubStrA := MidStr(Txt,1,p1-1);
730 p1 := p1 + FN_SHOW_TEXT_LEN;
731 p2 := PosEx(FN_SHOW_TEXT_END,Txt,p1);
[736]732 SubStrB := MidStr(Txt,p2+1,StrLen(PChar(Txt))+1); //Changed from 999 to StrLen(PChar(Txt))+1. Some characters were getting lost including the dialog tags that trigger the dialog box elh 04/13/10
[729]733 FnStr := MidStr(Txt,p1, (p2-p1));
734 FnStr := GetFormula(FnStr);
735 FnStr := SubstuteIDs(FnStr,NameToObjID);
736 Txt := SubStrA + FN_BEGIN_SIGNATURE + FnStr + FN_END_TAG + SubStrB;
737 Result := true;
738 p1 := PosEx(FN_SHOW_TEXT,Txt,p1);
739 end;
740 SL.Text := Txt;
741end;
742
743{
744function RestoreTransformFormulas(SL : TStrings; Formulas, NameToObjID : TStringList) : boolean; overload;
745//kt added 3/26/10
746//Returns if any changes made
747var
748 i: integer;
749 Changed : boolean;
750 txt: string;
751
752begin
753 Result := false;
754 for i := 0 to SL.Count-1 do begin
755 txt := SL[i];
756 Changed := RestoreTransformFormulas(txt, Formulas, NameToObjID);
757 Result := Result or Changed;
758 SL[i] := txt;
759 end;
760end;
761}
762
763function RestoreTransformTxtObjects(SL : TStrings; TxtObjects, NameToObjID : TStringList) : boolean;
764//kt added 3/28/10
765//Returns if any changes made
766//Replace formula text back in, and change field names into FldID's
767
768 function GetTxtObjects(NumStr : string) : string;
769 //Return TxtObject text based on provided index number of formula
770 var num, i : integer;
771 PtrNum : Pointer;
772 begin
773 Result := '';
774 try
775 Num := StrToInt(NumStr);
776 PtrNum := Pointer(Num);
777 for i := 0 to TxtObjects.Count-1 do begin
778 if TxtObjects.Objects[i] = PtrNum then begin
779 Result := TxtObjects.Strings[i];
780 break;
781 end;
782 end;
783 except
784 on EConvertError do Result := '??';
785 end;
786 end;
787
788var p1,p2 : integer;
789 count : integer;
790 ObjStr : string;
791 SubStrA,SubStrB : string;
792 Txt : string;
793begin
794 Txt := SL.Text;
795 Result := false;
796 p1 := Pos(OBJ_SHOW_TEXT,Txt);
797 while (p1>0) do begin
798 SubStrA := MidStr(Txt,1,p1-1);
799 p1 := p1 + OBJ_SHOW_TEXT_LEN;
800 p2 := PosEx(OBJ_SHOW_TEXT_END,Txt,p1);
[736]801 SubStrB := MidStr(Txt,p2+1,StrLen(PChar(Txt))+1); //Changed from 999 to StrLen(PChar(Txt))+1. Some characters were getting lost including the dialog tags that trigger the dialog box elh 04/13/10
[729]802 ObjStr := MidStr(Txt,p1, (p2-p1));
803 ObjStr := GetTxtObjects(ObjStr);
804 ObjStr := SubstuteIDs(ObjStr,NameToObjID);
805 Txt := SubStrA + FLD_OBJ_SIGNATURE + ObjStr + FLD_OBJ_END_TAG + SubStrB;
806 Result := true;
807 p1 := PosEx(OBJ_SHOW_TEXT,Txt,p1);
808 end;
809 SL.Text := Txt;
810end;
811
812
813function GetRPCTIUObj(TIUObjName : string) : string;
814//kt added entire function 3/28/10
815//Based on rTemplates.GetTemplateText(BoilerPlate: TStrings);
816begin
817 TIUObjName := AnsiReplaceText(TIUObjName,'|','');
818 with RPCBrokerV do begin
819 ClearParameters := True;
820 RemoteProcedure := 'TIU TEMPLATE GETTEXT';
821 Param[0].PType := literal;
822 Param[0].Value := Patient.DFN;
823 Param[1].PType := literal;
824 Param[1].Value := Encounter.VisitStr;
825 Param[2].PType := list;
826 Param[2].Mult[IntToStr(1)+',0'] := '|' + TIUObjName + '|';
827 CallBroker;
828 RPCBrokerV.Results.Delete(0);
829 if RPCBrokerV.Results.count > 0 then begin
830 Result := RPCBrokerV.Results.Strings[0];
831 end else Result := '';
832 RPCBrokerV.Results.Clear;
833 end;
834end;
835
836
837Procedure EvalTIUObjects(var Formula : string);
838//kt added entire function 3/28/10
839var p1,p2 : integer;
840 OP1,OP2 : integer;
841 Problem : boolean;
842 SubStrA, SubStrB : string;
843 TIUObj,Argument,s : string;
844begin
845 p1 := Pos(FN_OBJ_TAG, Formula);
846 while (p1 > 0) do begin
847 p2 := CloseCharPos('[',']',Formula, p1+1);
848 if p2=0 then begin
849 Formula := 'ERROR. Matching "]" not found after ' + FN_OBJ_TAG + '.';
850 Exit;
851 end;
852 SubStrA := MidStr(Formula,1,p1-1);
853 p1 := p1+FN_OBJ_TAG_LEN;
854 TIUObj := Trim(MidStr(Formula, p1, (p2-p1)));
855 SubStrB := MidStr(Formula,p2+1,999);
856 OP1 := Pos('{',TIUObj);
857 if (OP1 > 0) then begin
858 OP2 := CloseCharPos('{','}', TIUObj, OP1+1);
859 if OP2=0 then begin
860 Formula := 'ERROR. Matching ")" not found after "(".';
861 Exit;
862 end;
863 Argument := MidStr(TIUObj,OP1+1,(OP2-(OP1+1)));
864 if Pos(FN_OBJ_TAG,Argument)>0 then begin
865 EvalTIUObjects(Argument)
866 end;
867 Problem := false;
868 s := FloatToStr(StringEval(Argument,Problem));
869 if Problem then begin
870 Formula := 'ERROR evaluating argument: [' + s + '].';
871 Exit;
872 end else begin
873 Argument := s;
874 end;
875 TIUObj := MidStr(TIUObj,1,OP1-1) + '{' + Argument + '}';
876 end;
877 TIUObj := GetRPCTIUObj(TIUObj);
878 Formula := SubStrA + TIUObj + SubStrB;
879 p1 := Pos(FN_OBJ_TAG, Formula);
880 end;
881end;
882
883
884
[694]885procedure WordWrapText(var Txt: string; HTMLMode : boolean);
[453]886var
887 TmpSL: TStringList;
888 i: integer;
889
[694]890 function WrappedText(const Str: string; boolHTMLMode : boolean): string;
[453]891 var
[694]892 i, i2, j, k, m: integer;
893 HTMLStrLen : integer;
894 Temp, Temp1, Temp2: string;
[453]895
896 begin
897 Temp := Str;
898 Result := '';
899 i2 := 0;
900
901 repeat
902 i := pos(TemplateFieldBeginSignature, Temp);
903
904 if i>0 then
905 j := pos(TemplateFieldEndSignature, copy(Temp, i, MaxInt))
906 else
907 j := 0;
908
909 if (j > 0) then
910 begin
911 i2 := pos(TemplateFieldBeginSignature, copy(Temp, i+TemplateFieldSignatureLen, MaxInt));
912 if (i2 = 0) then
913 i2 := MaxInt
914 else
915 i2 := i + TemplateFieldSignatureLen + i2 - 1;
916 end;
917
918 if (i>0) and (j=0) then
919 i := 0;
920
921 if (i>0) and (j>0) then
922 if (j > i2) then
923 begin
924 Result := Result + copy(Temp, 1, i2-1);
925 delete(Temp, 1, i2-1);
926 end
927 else
928 begin
929 for k := (i+TemplateFieldSignatureLen) to (i+j-2) do
930 if Temp[k]=' ' then
931 Temp[k]:= #1;
932 i := i + j - 1;
933 Result := Result + copy(Temp,1,i);
934 delete(Temp,1,i);
935 end;
936
937 until (i = 0);
938
939 Result := Result + Temp;
[694]940
941 //Count the HTML tag length and add to MAX_ENTRY WIDTH elh 1-29-10
942 HTMLStrLen := 0;
943 if boolHTMLMode = True then begin
944 temp1 := Result;
945 while (pos('<',temp1)>0) and (pos('>',temp1)>0) do
946 begin
947 temp2 := MidStr(temp1,pos('<',temp1),pos('>',temp1)-pos('<',temp1)+1);
948 HTMLStrLen := HTMLStrLen + strlen(PChar(temp2));
949 temp1 := Rightstr(temp1,strlen(PChar(temp1))-pos('>',temp1));
950 end;
951 end;
952
953 Result := WrapText(Result, #13#10, [' '], MAX_ENTRY_WIDTH+HTMLStrLen); //added +HTMLStrLen elh 1-29-10
[453]954 repeat
955 i := pos(#1, Result);
956 if i > 0 then
957 Result[i] := ' ';
958 until i = 0;
959 end;
960
961begin
962 if length(Txt) > MAX_ENTRY_WIDTH then
963 begin
964 TmpSL := TStringList.Create;
965 try
966 TmpSL.Text := Txt;
967 Txt := '';
968 for i := 0 to TmpSL.Count-1 do
969 begin
970 if Txt <> '' then
971 Txt := Txt + CRLF;
[694]972 Txt := Txt + WrappedText(TmpSL[i],HTMLMode);
[453]973 end;
974 finally
975 TmpSL.Free;
976 end;
977 end;
978end;
979
980function ResolveTemplateFields(Text: string;
981 AutoWrap: boolean;
982 Hidden: boolean = FALSE;
[654]983 IncludeEmbedded: boolean = FALSE;
984 HTMLMode : boolean = FALSE; //kt added 12/28/09
985 HTMLAnswerOpenTag : string = ''; //kt added 12/28/09
986 HTMLAnswerCloseTag : string = '' //kt added 12/28/09
987 ): string;
[453]988var
989 flen, CtrlID, i, j: integer;
990 Entry: TTemplateDialogEntry;
991 iField, Temp, NewTxt, Fld: string;
[729]992 FoundEntry,Problem: boolean;
[453]993 TmplFld: TTemplateField;
[654]994 tempSL : TStringList;
[729]995 SubStrA, SubStrB : string; //kt
996 ExtMode : TMGExtension; //kt
997 TempStr, FnObjStr,Argument : string; //kt
998 FnP1,FnP2,p1,p2 : integer; //kt
[453]999
1000 procedure AddNewTxt;
1001 begin
1002 if(NewTxt <> '') then
1003 begin
1004 insert(StringOfChar('x',length(NewTxt)), Temp, i);
1005 insert(NewTxt, Result, i);
1006 inc(i, length(NewTxt));
1007 end;
1008 end;
1009
1010begin
1011 if(not assigned(uEntries)) then
1012 uEntries := TStringList.Create;
1013 Result := Text;
1014 Temp := Text; // Use Temp to allow template fields to contain other template field references
1015 repeat
1016 i := pos(TemplateFieldBeginSignature, Temp);
1017 if(i > 0) then
1018 begin
1019 CtrlID := 0;
1020 if(copy(Temp, i + TemplateFieldSignatureLen, 1) = FieldIDDelim) then
1021 begin
1022 CtrlID := StrToIntDef(copy(Temp, i + TemplateFieldSignatureLen + 1, FieldIDLen-1), 0);
1023 delete(Temp,i + TemplateFieldSignatureLen, FieldIDLen);
1024 delete(Result,i + TemplateFieldSignatureLen, FieldIDLen);
1025 end;
1026 j := pos(TemplateFieldEndSignature, copy(Temp, i + TemplateFieldSignatureLen, MaxInt));
1027 Fld := '';
1028 if(j > 0) then
1029 begin
1030 inc(j, i + TemplateFieldSignatureLen - 1);
1031 flen := j - i - TemplateFieldSignatureLen;
1032 Fld := copy(Temp,i + TemplateFieldSignatureLen, flen);
1033 delete(Temp,i,flen + TemplateFieldSignatureLen + 1);
1034 delete(Result,i,flen + TemplateFieldSignatureLen + 1);
1035 end
1036 else
1037 begin
1038 delete(Temp,i,TemplateFieldSignatureLen);
1039 delete(Result,i,TemplateFieldSignatureLen);
1040 end;
1041 if(CtrlID > 0) then
1042 begin
1043 FoundEntry := FALSE;
1044 for j := 0 to uEntries.Count-1 do
1045 begin
1046 Entry := TTemplateDialogEntry(uEntries.Objects[j]);
1047 if(assigned(Entry)) then
1048 begin
1049 if IncludeEmbedded then
1050 iField := Fld
1051 else
1052 iField := '';
1053 NewTxt := Entry.GetControlText(CtrlID, FALSE, FoundEntry, AutoWrap, iField);
1054 TmplFld := GetTemplateField(Fld, FALSE);
1055 if (assigned(TmplFld)) and (TmplFld.DateType in DateComboTypes) then {if this is a TORDateBox}
1056 NewTxt := Piece(NewTxt,':',1); {we only want the first piece of NewTxt}
[654]1057 //kt 12/28/09 --- Start mod to wrap answers in custom HTML tag ---
1058 if (HTMLMode=true) and (NewTxt <> '') then begin
1059 NewTxt := HTMLAnswerOpenTag + NewTxt + HTMLAnswerCloseTag; //kt 12/29/09
1060 end;
1061 //kt --- End mod to wrap answers in custom HTML tag ---
[453]1062 AddNewTxt;
1063 end;
1064 if FoundEntry then break;
1065 end;
1066 if Hidden and (not FoundEntry) and (Fld <> '') then
1067 begin
1068 NewTxt := TemplateFieldBeginSignature + Fld + TemplateFieldEndSignature;
1069 AddNewTxt;
1070 end;
1071 end;
[654]1072 end else begin
1073 if HTMLMode=true then begin
1074 tempSL := TStringList.create;
1075 tempSL.Text := Result;
1076 if tempSL.Count < 3 then begin
1077 Result := HTMLAnswerOpenTag + Result + HTMLAnswerCloseTag;
1078 end;
1079 tempSL.Free;
1080 end;
[453]1081 end;
1082 until(i = 0);
[729]1083
1084 //kt -- begin mod --- Entire section added.
1085 Temp := Result;
1086 for ExtMode := tmgeFN to tmgeOBJ do begin
1087 repeat
1088 i := pos(TMG_MATCH[ExtMode].Signature, Temp);
1089 if(i > 0) then begin
1090 FnP1 := i;
1091 FnP2 := CloseCharPos('{', TMG_MATCH[ExtMode].EndTag, Temp, i);
1092 //FnP2 := Pos(TMG_MATCH[ExtMode].EndTag,Temp); //Should use CloseCharPos function
1093 p1 := FnP1 + TMG_MATCH[ExtMode].SigLen;
1094 FnObjStr := MidStr(Temp, p1, FnP2-p1);
1095 p1 := Pos(FieldIDDelim,FnObjStr);
1096 while (p1 > 0) do begin
1097 SubStrA := MidStr(FnObjStr,1,p1-1);
1098 p2 := PosEx(FieldIDDelim,FnObjStr,p1+1);
1099 Argument := MidStr(FnObjStr,p1+1,(p2-p1)-1);
[736]1100 SubStrB := MidStr(FnObjStr,p2+1,StrLen(PChar(FnObjStr))+1);
[729]1101 CtrlID := StrToIntDef(MidStr(Argument,1,FieldIDLen-1), 0);
[736]1102 Fld := MidStr(Argument,FieldIDLen,StrLen(PChar(Argument))+1);
[729]1103 if(CtrlID > 0) then begin
1104 FoundEntry := FALSE;
1105 for j := 0 to uEntries.Count-1 do begin
1106 Entry := TTemplateDialogEntry(uEntries.Objects[j]);
1107 if(assigned(Entry)) then begin
1108 if IncludeEmbedded then
1109 iField := Fld
1110 else
1111 iField := '';
1112 NewTxt := Entry.GetControlText(CtrlID, FALSE, FoundEntry, AutoWrap, iField);
1113 TmplFld := GetTemplateField(Fld, FALSE);
1114 if (assigned(TmplFld)) and (TmplFld.DateType in DateComboTypes) then {if this is a TORDateBox}
1115 NewTxt := Piece(NewTxt,':',1); {we only want the first piece of NewTxt}
1116 Argument := Trim(NewTxt);
1117 end;
1118 end;
1119 end else Argument := '??';
1120 FnObjStr := SubStrA + Argument + SubStrB;
1121 p1 := Pos(FieldIDDelim,FnObjStr);
1122 end;
1123 if (ExtMode = tmgeOBJ) then begin
1124 FnObjStr := FN_OBJ_TAG + FnObjStr + ']';
1125 end;
[735]1126 FnObjStr := FormatFormula(FnObjStr); //Added to remove all characters from the formula elh 4/9/10
[729]1127 if (Pos(FN_OBJ_TAG,FnObjStr)>0) then begin
1128 EvalTIUObjects(FnObjStr);
1129 end;
1130 if ExtMode = tmgeFN then begin
1131 Problem := false;
1132 TempStr := AnsiReplaceText(FnObjStr,' ','');
1133 TempStr := FloatToStr(StringEval(TempStr,Problem));
1134 if not Problem then FnObjStr := TempStr;
1135 end;
1136 SubStrA := MidStr(Temp,1,FnP1-1);
[736]1137 SubStrB := MidStr(Temp,FnP2+1,StrLen(PChar(Temp))+1);
[729]1138 if (HTMLMode=true) and (FnObjStr <> '') then begin
1139 FnObjStr := HTMLAnswerOpenTag + FnObjStr + HTMLAnswerCloseTag;
1140 end;
1141 Temp := SubStrA + FnObjStr + SubStrB;
1142 end else begin
1143 if HTMLMode=true then begin
1144 tempSL := TStringList.create;
1145 tempSL.Text := Result;
1146 if tempSL.Count < 3 then begin
1147 Result := HTMLAnswerOpenTag + Result + HTMLAnswerCloseTag;
1148 end;
1149 tempSL.Free;
1150 end;
1151 end;
1152 until(i = 0);
1153 end;
1154 Result := Temp;
1155 //kt -- end mod --
1156
[453]1157 if not AutoWrap then
[694]1158 WordWrapText(Result,HTMLMode);
[654]1159
[453]1160end;
1161
1162function AreTemplateFieldsRequired(const Text: string; FldValues: TORStringList = nil): boolean;
1163var
1164 flen, CtrlID, i, j: integer;
1165 Entry: TTemplateDialogEntry;
1166 Fld: TTemplateField;
1167 Temp, NewTxt, FldName: string;
1168 FoundEntry: boolean;
[729]1169 SubStrA,SubStrB : string;
[453]1170
1171begin
1172 if(not assigned(uEntries)) then
1173 uEntries := TStringList.Create;
1174 Temp := Text;
1175 Result := FALSE;
1176 repeat
1177 i := pos(TemplateFieldBeginSignature, Temp);
1178 if(i > 0) then
1179 begin
1180 CtrlID := 0;
1181 if(copy(Temp, i + TemplateFieldSignatureLen, 1) = FieldIDDelim) then
1182 begin
1183 CtrlID := StrToIntDef(copy(Temp, i + TemplateFieldSignatureLen + 1, FieldIDLen-1), 0);
1184 delete(Temp,i + TemplateFieldSignatureLen, FieldIDLen);
1185 end;
1186 j := pos(TemplateFieldEndSignature, copy(Temp, i + TemplateFieldSignatureLen, MaxInt));
1187 if(j > 0) then
1188 begin
1189 inc(j, i + TemplateFieldSignatureLen - 1);
1190 flen := j - i - TemplateFieldSignatureLen;
1191 FldName := copy(Temp, i + TemplateFieldSignatureLen, flen);
1192 Fld := GetTemplateField(FldName, FALSE);
1193 delete(Temp,i,flen + TemplateFieldSignatureLen + 1);
1194 end
1195 else
1196 begin
1197 delete(Temp,i,TemplateFieldSignatureLen);
1198 Fld := nil;
1199 end;
1200 if(CtrlID > 0) and (assigned(Fld)) and (Fld.Required) then
1201 begin
1202 FoundEntry := FALSE;
1203 for j := 0 to uEntries.Count-1 do
1204 begin
1205 Entry := TTemplateDialogEntry(uEntries.Objects[j]);
1206 if(assigned(Entry)) then
1207 begin
1208 NewTxt := Entry.GetControlText(CtrlID, TRUE, FoundEntry, FALSE);
1209 if FoundEntry and (NewTxt = '') then
1210 Result := TRUE;
1211 end;
1212 if FoundEntry then break;
1213 end;
1214 if (not FoundEntry) and assigned(FldValues) then
1215 begin
1216 j := FldValues.IndexOfPiece(IntToStr(CtrlID));
1217 if(j < 0) or (Piece(FldValues[j],U,2) = '') then
1218 Result := TRUE;
1219 end;
1220 end;
1221 end;
1222 until((i = 0) or Result);
1223end;
1224
1225function HasTemplateField(txt: string): boolean;
1226begin
1227 Result := (pos(TemplateFieldBeginSignature, txt) > 0);
1228end;
1229
1230function GetTemplateField(ATemplateField: string; ByIEN: boolean): TTemplateField;
1231var
1232 i, idx: integer;
1233 AData: TStrings;
1234
1235begin
1236 Result := nil;
1237 if(not assigned(uTmplFlds)) then
1238 uTmplFlds := TList.Create;
1239 idx := -1;
1240 for i := 0 to uTmplFlds.Count-1 do
1241 begin
1242 if(ByIEN) then
1243 begin
1244 if(TTemplateField(uTmplFlds[i]).FID = ATemplateField) then
1245 begin
1246 idx := i;
1247 break;
1248 end;
1249 end
1250 else
1251 begin
1252 if(TTemplateField(uTmplFlds[i]).FFldName = ATemplateField) then
1253 begin
1254 idx := i;
1255 break;
1256 end;
1257 end;
1258 end;
1259 if(idx < 0) then
1260 begin
1261 if(ByIEN) then
1262 AData := LoadTemplateFieldByIEN(ATemplateField)
1263 else
1264 AData := LoadTemplateField(ATemplateField);
1265 if(AData.Count > 1) then
1266 Result := TTemplateField.Create(AData);
1267 end
1268 else
1269 Result := TTemplateField(uTmplFlds[idx]);
1270end;
1271
1272function TemplateFieldNameProblem(Fld: TTemplateField): boolean;
1273//const
1274//DUPFLD = 'Field Name is not unique'; <-- original line. //kt 8/8/2007
1275
1276var
1277 i: integer;
1278 msg: string;
1279 DUPFLD : string; //kt
1280
1281begin
1282 DUPFLD := DKLangConstW('uTemplateFields_Field_Name_is_not_unique'); //kt added 8/8/2007
1283 msg := '';
1284 if(Fld.FldName = NewTemplateField) then
1285// msg := 'Field Name can not be ' + NewTemplateField <-- original line. //kt 8/8/2007
1286 msg := DKLangConstW('uTemplateFields_Field_Name_can_not_be') + NewTemplateField //kt added 8/8/2007
1287 else
1288 if(length(Fld.FldName) < 3) then
1289// msg := 'Field Name must be at least three characters in length' <-- original line. //kt 8/8/2007
1290 msg := DKLangConstW('uTemplateFields_Field_Name_must_be_at_least_three_characters_in_length') //kt added 8/8/2007
1291 else
1292 if(not (Fld.FldName[1] in ['A'..'Z','0'..'9'])) then
1293// msg := 'First Field Name character must be "A" - "Z", or "0" - "9"' <-- original line. //kt 8/8/2007
1294 msg := DKLangConstW('uTemplateFields_First_Field_Name_character_must_be_xAx_x_xZxx_or_x0x_x_x9x') //kt added 8/8/2007
1295 else
1296 if(assigned(uTmplFlds)) then
1297 begin
1298 for i := 0 to uTmplFlds.Count-1 do
1299 begin
1300 if(Fld <> uTmplFlds[i]) and
1301 (CompareText(TTemplateField(uTmplFlds[i]).FFldName, Fld.FFldName) = 0) then
1302 begin
1303 msg := DUPFLD;
1304 break;
1305 end;
1306 end;
1307 end;
1308 if(msg = '') and (not IsTemplateFieldNameUnique(Fld.FFldName, Fld.ID)) then
1309 msg := DUPFLD;
1310 Result := (msg <> '');
1311 if(Result) then
1312 ShowMessage(msg);
1313end;
1314
1315function SaveTemplateFieldErrors: string;
1316var
1317 i: integer;
1318 Errors: TStringList;
1319 Fld: TTemplateField;
1320 msg: string;
1321
1322begin
1323 Result := '';
1324 if(assigned(uTmplFlds)) then
1325 begin
1326 Errors := nil;
1327 try
1328 for i := 0 to uTmplFlds.Count-1 do
1329 begin
1330 Fld := TTemplateField(uTmplFlds[i]);
1331 if(Fld.FModified) then
1332 begin
1333 msg := Fld.SaveError;
1334 if(msg <> '') then
1335 begin
1336 if(not assigned(Errors)) then
1337 begin
1338 Errors := TStringList.Create;
1339// Errors.Add('The following template field save errors have occurred:'); <-- original line. //kt 8/8/2007
1340 Errors.Add(DKLangConstW('uTemplateFields_The_following_template_field_save_errors_have_occurredx')); //kt added 8/8/2007
1341 Errors.Add('');
1342 end;
1343 Errors.Add(' ' + Fld.FldName + ': ' + msg);
1344 end;
1345 end;
1346 end;
1347 finally
1348 if(assigned(Errors)) then
1349 begin
1350 Result := Errors.Text;
1351 Errors.Free;
1352 end;
1353 end;
1354 end;
1355end;
1356
1357procedure ClearModifiedTemplateFields;
1358var
1359 i: integer;
1360 Fld: TTemplateField;
1361
1362begin
1363 if(assigned(uTmplFlds)) then
1364 begin
1365 for i := uTmplFlds.Count-1 downto 0 do
1366 begin
1367 Fld := TTemplateField(uTmplFlds[i]);
1368 if(assigned(Fld)) and (Fld.FModified) then
1369 begin
1370 if Fld.FLocked then
1371 UnlockTemplateField(Fld.FID);
1372 Fld.Free;
1373 end;
1374 end;
1375 end;
1376end;
1377
1378function AnyTemplateFieldsModified: boolean;
1379var
1380 i: integer;
1381
1382begin
1383 Result := FALSE;
1384 if(assigned(uTmplFlds)) then
1385 begin
1386 for i := 0 to uTmplFlds.Count-1 do
1387 begin
1388 if(TTemplateField(uTmplFlds[i]).FModified) then
1389 begin
1390 Result := TRUE;
1391 break;
1392 end;
1393 end;
1394 end;
1395end;
1396
1397procedure ListTemplateFields(const AText: string; AList: TStrings; ListErrors: boolean = FALSE);
1398var
1399 i, j, k, flen, BadCount: integer;
1400 flddesc, tmp, fld: string;
1401 TmpList: TStringList;
1402 InactiveList: TStringList;
1403 FldObj: TTemplateField;
1404
1405begin
1406 if(AText = '') then exit;
1407 BadCount := 0;
1408 InactiveList := TStringList.Create;
1409 try
1410 TmpList := TStringList.Create;
1411 try
1412 TmpList.Text := AText;
1413 for k := 0 to TmpList.Count-1 do
1414 begin
1415 tmp := TmpList[k];
1416 repeat
1417 i := pos(TemplateFieldBeginSignature, tmp);
1418 if(i > 0) then
1419 begin
1420 fld := '';
1421 j := pos(TemplateFieldEndSignature, copy(tmp, i + TemplateFieldSignatureLen, MaxInt));
1422 if(j > 0) then
1423 begin
1424 inc(j, i + TemplateFieldSignatureLen - 1);
1425 flen := j - i - TemplateFieldSignatureLen;
1426 fld := copy(tmp,i + TemplateFieldSignatureLen, flen);
1427 delete(tmp, i, flen + TemplateFieldSignatureLen + 1);
1428 end
1429 else
1430 begin
1431 delete(tmp,i,TemplateFieldSignatureLen);
1432 inc(BadCount);
1433 end;
1434 if(fld <> '') then
1435 begin
1436 if ListErrors then
1437 begin
1438 FldObj := GetTemplateField(fld, FALSE);
1439 if assigned(FldObj) then
1440 begin
1441 if FldObj.Inactive then
1442 InactiveList.Add(' "' + fld + '"');
1443 flddesc := '';
1444 end
1445 else
1446 flddesc := ' "' + fld + '"';
1447 end
1448 else
1449 flddesc := fld;
1450 if(flddesc <> '') and (AList.IndexOf(flddesc) < 0) then
1451 AList.Add(flddesc)
1452 end;
1453 end;
1454 until (i = 0);
1455 end;
1456 finally
1457 TmpList.Free;
1458 end;
1459 if ListErrors then
1460 begin
1461 if(AList.Count > 0) then
1462// AList.Insert(0, 'The following template fields were not found:'); <-- original line. //kt 8/8/2007
1463 AList.Insert(0, DKLangConstW('uTemplateFields_The_following_template_fields_were_not_foundx')); //kt added 8/8/2007
1464 if (BadCount > 0) then
1465 begin
1466 if(BadCount = 1) then
1467// tmp := 'A template field marker "' + TemplateFieldBeginSignature + <-- original line. //kt 8/8/2007
1468 tmp := DKLangConstW('uTemplateFields_A_template_field_marker_x') + TemplateFieldBeginSignature + //kt added 8/8/2007
1469// '" was found without a' <-- original line. //kt 8/8/2007
1470 DKLangConstW('uTemplateFields_x_was_found_without_a') //kt added 8/8/2007
1471 else
1472// tmp := IntToStr(BadCount) + ' template field markers "' + TemplateFieldBeginSignature + <-- original line. //kt 8/8/2007
1473 tmp := IntToStr(BadCount) + DKLangConstW('uTemplateFields_template_field_markers_x') + TemplateFieldBeginSignature + //kt added 8/8/2007
1474// '" were found without'; <-- original line. //kt 8/8/2007
1475 DKLangConstW('uTemplateFields_x_were_found_without'); //kt added 8/8/2007
1476 if(AList.Count > 0) then
1477 AList.Add('');
1478// AList.Add(tmp + ' matching "' + TemplateFieldEndSignature + '"'); <-- original line. //kt 8/8/2007
1479 AList.Add(tmp + DKLangConstW('uTemplateFields_matching_x') + TemplateFieldEndSignature + '"'); //kt added 8/8/2007
1480 end;
1481 if(InactiveList.Count > 0) then
1482 begin
1483 if(AList.Count > 0) then
1484 AList.Add('');
1485// AList.Add('The following inactive template fields were found:'); <-- original line. //kt 8/8/2007
1486 AList.Add(DKLangConstW('uTemplateFields_The_following_inactive_template_fields_were_foundx')); //kt added 8/8/2007
1487 AList.AddStrings(InactiveList);
1488 end;
1489 if(AList.Count > 0) then
1490 begin
1491// AList.Insert(0, 'Text contains template field errors:'); <-- original line. //kt 8/8/2007
1492 AList.Insert(0, DKLangConstW('uTemplateFields_Text_contains_template_field_errorsx')); //kt added 8/8/2007
1493 AList.Insert(1, '');
1494 end;
1495 end;
1496 finally
1497 InactiveList.Free;
1498 end;
1499end;
1500
1501function BoilerplateTemplateFieldsOK(const AText: string; Msg: string = ''): boolean;
1502var
1503 Errors: TStringList;
1504 btns: TMsgDlgButtons;
1505
1506begin
1507 Result := TRUE;
1508 Errors := TStringList.Create;
1509 try
1510 ListTemplateFields(AText, Errors, TRUE);
1511 if(Errors.Count > 0) then
1512 begin
1513 if(Msg = 'OK') then
1514 btns := [mbOK]
1515 else
1516 begin
1517 btns := [mbAbort, mbIgnore];
1518 Errors.Add('');
1519 if(Msg = '') then
1520// Msg := 'text insertion'; <-- original line. //kt 8/8/2007
1521 Msg := DKLangConstW('uTemplateFields_text_insertion'); //kt added 8/8/2007
1522// Errors.Add('Do you want to Abort ' + Msg + ', or Ignore the error and continue?'); <-- original line. //kt 8/8/2007
1523 Errors.Add(DKLangConstW('uTemplateFields_Do_you_want_to_Abort')+' ' + Msg + DKLangConstW('uTemplateFields_x_or_Ignore_the_error_and_continuex')); //kt added 8/8/2007
1524 end;
1525 Result := (MessageDlg(Errors.Text, mtError, btns, 0) = mrIgnore);
1526 end;
1527 finally
1528 Errors.Free;
1529 end;
1530end;
1531
1532procedure EnsureText(edt: TEdit; ud: TUpDown);
1533var
1534 v: integer;
1535 s: string;
1536
1537begin
1538 if assigned(ud.Associate) then
1539 begin
1540 v := StrToIntDef(edt.Text, ud.Position);
1541 if (v < ud.Min) or (v > ud.Max) then
1542 v := ud.Position;
1543 s := IntToStr(v);
1544 if edt.Text <> s then
1545 edt.Text := s;
1546 end;
1547 edt.SelStart := edt.GetTextLen;
1548end;
1549
1550function TemplateFieldCode2Field(const Code: string): TTemplateFieldType;
1551var
1552 typ: TTemplateFieldType;
1553
1554begin
1555 Result := dftUnknown;
1556 for typ := low(TTemplateFieldType) to high(TTemplateFieldType) do
1557 if Code = TemplateFieldTypeCodes[typ] then
1558 begin
1559 Result := typ;
1560 break;
1561 end;
1562end;
1563
1564function TemplateDateCode2DateType(const Code: string): TTmplFldDateType;
1565var
1566 typ: TTmplFldDateType;
1567
1568begin
1569 Result := dtUnknown;
1570 for typ := low(TTmplFldDateType) to high(TTmplFldDateType) do
1571 if Code = TemplateFieldDateCodes[typ] then
1572 begin
1573 Result := typ;
1574 break;
1575 end;
1576end;
1577
1578procedure ConvertCodes2Text(sl: TStrings; Short: boolean);
1579var
1580 i: integer;
1581 tmp, output: string;
1582 ftype: TTemplateFieldType;
1583 dtype: TTmplFldDateType;
1584
1585begin
1586 for i := 0 to sl.Count-1 do
1587 begin
1588 tmp := sl[i];
1589 if piece(tmp,U,4) = BOOLCHAR[TRUE] then
1590 output := '* '
1591 else
1592 output := ' ';
1593 ftype := TemplateFieldCode2Field(Piece(tmp, U, 3));
1594 if ftype = dftDate then
1595 begin
1596 dtype := TemplateDateCode2DateType(Piece(tmp, U, 5));
1597 //kt output := output + TemplateDateTypeDesc[dtype, short];
1598 output := output + TemplateDateTypeDesc(dtype, short);
1599 end
1600 else
1601 //kt output := output + TemplateFieldTypeDesc[ftype, short];
1602 output := output + TemplateFieldTypeDesc(ftype, short);
1603 SetPiece(tmp, U, 3, output);
1604 sl[i] := tmp;
1605 end;
1606end;
1607
1608{ TTemplateField }
1609
1610constructor TTemplateField.Create(AData: TStrings);
1611var
1612 tmp, p1: string;
1613 AFID, i,idx,cnt: integer;
1614
1615begin
1616 AFID := 0;
1617 if(assigned(AData)) then
1618 begin
1619 if AData.Count > 0 then
1620 AFID := StrToIntDef(AData[0],0);
1621 if(AFID > 0) and (AData.Count > 1) then
1622 begin
1623 FID := IntToStr(AFID);
1624 FFldName := Piece(AData[1],U,1);
1625 FFldType := TemplateFieldCode2Field(Piece(AData[1],U,2));
1626 FInactive := (Piece(AData[1],U,3) = '1');
1627 FMaxLen := StrToIntDef(Piece(AData[1],U,4),0);
1628 FEditDefault := Piece(AData[1],U,5);
1629 FLMText := Piece(AData[1],U,6);
1630 idx := StrToIntDef(Piece(AData[1],U,7),0);
1631 cnt := 0;
1632 for i := 2 to AData.Count-1 do
1633 begin
1634 tmp := AData[i];
1635 p1 := Piece(tmp,U,1);
1636 tmp := Piece(tmp,U,2);
1637 if(p1 = 'D') then
1638 FNotes := FNotes + tmp + CRLF
1639 else
1640 if(p1 = 'U') then
1641 FURL := tmp
1642 else
1643 if(p1 = 'I') then
1644 begin
1645 inc(cnt);
1646 FItems := FItems + tmp + CRLF;
1647 if(cnt=idx) then
1648 FItemDefault := tmp;
1649 end;
1650 end;
1651 FRequired := (Piece(AData[1],U,8) = '1');
1652 FSepLines := (Piece(AData[1],U,9) = '1');
1653 FTextLen := StrToIntDef(Piece(AData[1],U,10),0);
1654 FIndent := StrToIntDef(Piece(AData[1],U,11),0);
1655 FPad := StrToIntDef(Piece(AData[1],U,12),0);
1656 FMinVal := StrToIntDef(Piece(AData[1],U,13),0);
1657 FMaxVal := StrToIntDef(Piece(AData[1],U,14),0);
1658 FIncrement := StrToIntDef(Piece(AData[1],U,15),0);
1659 FDateType := TemplateDateCode2DateType(Piece(AData[1],U,16));
1660 FModified := FALSE;
1661 FNameChanged := FALSE;
1662 end;
1663 end;
1664 if(AFID = 0) then
1665 begin
1666 inc(uNewTemplateFieldIDCnt);
1667 FID := IntToStr(-uNewTemplateFieldIDCnt);
1668 FFldName := NewTemplateField;
1669 FModified := TRUE;
1670 end;
1671 if(not assigned(uTmplFlds)) then
1672 uTmplFlds := TList.Create;
1673 uTmplFlds.Add(Self);
1674end;
1675
1676function TTemplateField.GetTemplateFieldDefault: string;
1677begin
1678 case FFldType of
1679 dftEditBox, dftNumber: Result := FEditDefault;
1680
1681 dftComboBox,
1682 dftButton,
1683 dftCheckBoxes, {Clear out embedded fields}
1684 dftRadioButtons: Result := StripEmbedded(FItemDefault);
1685
1686 dftDate: if FEditDefault <> '' then Result := FEditDefault;
1687
1688 dftHyperlink, dftText: if FEditDefault <> '' then
1689 Result := StripEmbedded(FEditDefault)
1690 else
1691 Result := URL;
1692
1693 dftWP: Result := Items;
1694 end;
1695end;
1696
1697procedure TTemplateField.CreateDialogControls(Entry: TTemplateDialogEntry;
1698 var Index: Integer; CtrlID: integer);
1699
1700var
1701 i, Aht, w, tmp, AWdth: integer;
1702 STmp: string;
1703 TmpSL: TStringList;
1704 edt: TEdit;
1705 cbo: TORComboBox;
1706 cb: TORCheckBox;
1707 btn: TfraTemplateFieldButton;
1708 dbox: TORDateBox;
1709 dcbo: TORDateCombo;
1710 lbl: TFieldLabel;
1711 re: TRichEdit;
1712 pnl: TPanel;
1713 ud: TUpDown;
1714 DefDate: TFMDateTime;
1715 ctrl: TControl;
1716
1717 function wdth: integer;
1718 begin
1719 if(Awdth < 0) then
1720 Awdth := FontWidthPixel(Entry.FFont.Handle);
1721 Result := Awdth;
1722 end;
1723
1724 function ht: integer;
1725 begin
1726 if(Aht < 0) then
1727 Aht := FontHeightPixel(Entry.FFont.Handle);
1728 Result := Aht;
1729 end;
1730
1731 procedure UpdateIndents(AControl: TControl);
1732 var
1733 idx: integer;
1734
1735 begin
1736 if (FIndent > 0) or (FPad > 0) then
1737 begin
1738 idx := Entry.FIndents.IndexOfObject(AControl);
1739 if idx < 0 then
1740 Entry.FIndents.AddObject(IntToStr(FIndent * wdth) + U + IntToStr(FPad), AControl);
1741 end;
1742 end;
1743
1744begin
1745 if(not FInactive) and (FFldType <> dftUnknown) then
1746 begin
1747 AWdth := -1;
1748 Aht := -1;
1749 ctrl := nil;
1750
1751 case FFldType of
1752 dftEditBox:
1753 begin
1754 edt := TEdit.Create(nil);
1755 edt.Parent := Entry.FPanel;
1756 edt.BorderStyle := bsNone;
1757 edt.Height := ht;
1758 edt.Width := (wdth * Width + 4);
1759 if FTextLen > 0 then
1760 edt.MaxLength := FTextLen
1761 else
1762 edt.MaxLength := FMaxLen;
1763 edt.Text := FEditDefault;
1764 edt.Tag := CtrlID;
1765 edt.OnChange := Entry.DoChange;
1766 ctrl := edt;
1767 end;
1768
1769 dftComboBox:
1770 begin
1771 cbo := TORComboBox.Create(nil);
1772 cbo.Parent := Entry.FPanel;
1773 cbo.TemplateField := TRUE;
1774 w := Width;
1775 cbo.MaxLength := w;
1776 if FTextLen > 0 then
1777 cbo.MaxLength := FTextLen
1778 else
1779 cbo.ListItemsOnly := TRUE;
1780 {Clear out embedded fields}
1781 cbo.Items.Text := StripEmbedded(Items);
1782 cbo.SelectByID(StripEmbedded(FItemDefault));
1783 cbo.Tag := CtrlID;
1784 cbo.OnClick := Entry.DoChange;
1785
1786 if cbo.Items.Count > 12 then
1787 begin
1788 cbo.Width := (wdth * w) + ScrollBarWidth + 8;
1789 cbo.DropDownCount := 12;
1790 end
1791 else
1792 begin
1793 cbo.Width := (wdth * w) + 18;
1794 cbo.DropDownCount := cbo.Items.Count;
1795 end;
1796 ctrl := cbo;
1797 end;
1798
1799 dftButton:
1800 begin
1801 btn := TfraTemplateFieldButton.Create(nil);
1802 btn.Parent := Entry.FPanel;
1803 {Clear out embedded fields}
1804 btn.Items.Text := StripEmbedded(Items);
1805 btn.ButtonText := StripEmbedded(FItemDefault);
1806 btn.Height := ht;
1807 btn.Width := (wdth * Width) + 6;
1808 btn.Tag := CtrlID;
1809 btn.OnChange := Entry.DoChange;
1810 ctrl := btn;
1811 end;
1812
1813 dftCheckBoxes, dftRadioButtons:
1814 begin
1815 if FFldType = dftRadioButtons then
1816 inc(uRadioGroupIndex);
1817 TmpSL := TStringList.Create;
1818 try
1819 {Clear out embedded fields}
1820 TmpSL.Text := StripEmbedded(Items);
1821 for i := 0 to TmpSL.Count-1 do
1822 begin
1823 cb := TORCheckBox.Create(nil);
1824 cb.Parent := Entry.FPanel;
1825 cb.Caption := TmpSL[i];
1826 cb.AutoSize := TRUE;
1827 cb.AutoAdjustSize;
1828 // cb.AutoSize := FALSE;
1829 // cb.Height := ht;
1830 if FFldType = dftRadioButtons then
1831 begin
1832 cb.GroupIndex := uRadioGroupIndex;
1833 cb.RadioStyle := TRUE;
1834 end;
1835 if(TmpSL[i] = StripEmbedded(FItemDefault)) then
1836 cb.Checked := TRUE;
1837 cb.Tag := CtrlID;
1838 if FSepLines and (FFldType in SepLinesTypes) then
1839 cb.StringData := NewLine;
1840 cb.OnClick := Entry.DoChange;
1841 inc(Index);
1842 Entry.FControls.InsertObject(Index, '', cb);
1843 if (i=0) or FSepLines then
1844 UpdateIndents(cb);
1845 end;
1846 finally
1847 TmpSL.Free;
1848 end;
1849 end;
1850
1851 dftDate:
1852 begin
1853 if FEditDefault <> '' then
1854 DefDate := StrToFMDateTime(FEditDefault)
1855 else
1856 DefDate := 0;
1857 if FDateType in DateComboTypes then
1858 begin
1859 dcbo := TORDateCombo.Create(nil);
1860 dcbo.Parent := Entry.FPanel;
1861 dcbo.Tag := CtrlID;
1862 dcbo.IncludeBtn := (FDateType = dtCombo);
1863 dcbo.IncludeDay := (FDateType = dtCombo);
1864 dcbo.IncludeMonth := (FDateType <> dtYear);
1865 dcbo.FMDate := DefDate;
1866 dcbo.TemplateField := TRUE;
1867 dcbo.OnChange := Entry.DoChange;
1868 ctrl := dcbo;
1869 end
1870 else
1871 begin
1872 dbox := TORDateBox.Create(nil);
1873 dbox.Parent := Entry.FPanel;
1874 dbox.Tag := CtrlID;
1875 dbox.DateOnly := (FDateType = dtDate);
1876 dbox.RequireTime := (FDateType = dtDateReqTime);
1877 dbox.TemplateField := TRUE;
1878 dbox.FMDateTime := DefDate;
1879 if (FDateType = dtDate) then
1880 tmp := 11
1881 else
1882 tmp := 17;
1883 dbox.Width := (wdth * tmp) + 18;
1884 dbox.OnChange := Entry.DoChange;
1885 ctrl := dbox;
1886 end;
1887 end;
1888
1889 dftNumber:
1890 begin
1891 pnl := TPanel.Create(nil);
1892 pnl.Parent := Entry.FPanel;
1893 pnl.BevelOuter := bvNone;
1894 pnl.Tag := CtrlID;
1895 edt := TEdit.Create(pnl);
1896 edt.Parent := pnl;
1897 edt.BorderStyle := bsNone;
1898 edt.Height := ht;
1899 edt.Width := (wdth * 5 + 4);
1900 edt.Top := 0;
1901 edt.Left := 0;
1902 edt.AutoSelect := True;
1903 ud := TUpDown.Create(pnl);
1904 ud.Parent := pnl;
1905 ud.Associate := edt;
1906 ud.Min := MinVal;
1907 ud.Max := MaxVal;
1908 ud.Min := MinVal; // Both ud.Min settings are needeed!
1909 i := Increment;
1910 if i < 1 then i := 1;
1911 ud.Increment := i;
1912 ud.Thousands := FALSE;
1913 ud.Position := StrToIntDef(EditDefault, 0);
1914 edt.Tag := Integer(ud);
1915 edt.OnChange := Entry.UpDownChange;
1916 pnl.Height := edt.Height;
1917 pnl.Width := edt.Width + ud.Width;
1918 ctrl := pnl;
1919 end;
1920
1921 dftHyperlink, dftText:
1922 begin
1923 if (FFldType = dftHyperlink) and User.WebAccess then
1924 lbl := TWebLabel.Create(nil)
1925 else
1926 lbl := TFieldLabel.Create(nil);
1927 lbl.Parent := Entry.FPanel;
1928 lbl.ShowAccelChar := FALSE;
1929 lbl.FExclude := FSepLines;
1930 if (FFldType = dftHyperlink) then
1931 begin
1932 if FEditDefault <> '' then
1933 lbl.Caption := StripEmbedded(FEditDefault)
1934 else
1935 lbl.Caption := URL;
1936 end
1937 else
1938 begin
1939 STmp := StripEmbedded(Items);
1940 if copy(STmp,length(STmp)-1,2) = CRLF then
1941 delete(STmp,length(STmp)-1,2);
1942 lbl.Caption := STmp;
1943 end;
1944 if lbl is TWebLabel then
1945 TWebLabel(lbl).Init(FURL);
1946 lbl.Tag := CtrlID;
1947 ctrl := lbl;
1948 end;
1949
1950 dftWP:
1951 begin
1952 re := TRichEdit.Create(nil);
1953 re.Parent := Entry.FPanel;
1954 re.Tag := CtrlID;
1955 tmp := FMaxLen;
1956 if tmp < 5 then
1957 tmp := 5;
1958 re.Width := wdth * tmp;
1959 tmp := FTextLen;
1960 if tmp < 2 then
1961 tmp := 2
1962 else
1963 if tmp > MaxTFWPLines then
1964 tmp := MaxTFWPLines;
1965 re.Height := ht * tmp;
1966 re.BorderStyle := bsNone;
1967 re.ScrollBars := ssVertical;
1968 re.Lines.Text := Items;
1969 re.OnChange := Entry.DoChange;
1970 ctrl := re;
1971 end;
1972 end;
1973 if assigned(ctrl) then
1974 begin
1975 inc(Index);
1976 Entry.FControls.InsertObject(Index, '', ctrl);
1977 UpdateIndents(ctrl);
1978 end;
1979 end;
1980end;
1981
1982function TTemplateField.CanModify: boolean;
1983begin
1984 if((not FModified) and (not FLocked) and (StrToIntDef(FID,0) > 0)) then
1985 begin
1986 FLocked := LockTemplateField(FID);
1987 Result := FLocked;
1988 if(not FLocked) then
1989// ShowMessage('Template Field ' + FFldName + ' is currently being edited by another user.'); <-- original line. //kt 8/8/2007
1990 ShowMessage(DKLangConstW('uTemplateFields_Template_Field')+' ' + FFldName + DKLangConstW('uTemplateFields_is_currently_being_edited_by_another_userx')); //kt added 8/8/2007
1991 end
1992 else
1993 Result := TRUE;
1994 if(Result) then FModified := TRUE;
1995end;
1996
1997procedure TTemplateField.SetEditDefault(const Value: string);
1998begin
1999 if(FEditDefault <> Value) and CanModify then
2000 FEditDefault := Value;
2001end;
2002
2003procedure TTemplateField.SetFldName(const Value: string);
2004begin
2005 if(FFldName <> Value) and CanModify then
2006 begin
2007 FFldName := Value;
2008 FNameChanged := TRUE;
2009 end;
2010end;
2011
2012procedure TTemplateField.SetFldType(const Value: TTemplateFieldType);
2013begin
2014 if(FFldType <> Value) and CanModify then
2015 begin
2016 FFldType := Value;
2017 if(Value = dftEditBox) then
2018 begin
2019 if (FMaxLen < 1) then
2020 FMaxLen := 1;
2021 if FTextLen < FMaxLen then
2022 FTextLen := FMaxLen;
2023 end
2024 else
2025 if(Value = dftHyperlink) and (FURL = '') then
2026 FURL := 'http://'
2027 else
2028 if(Value = dftComboBox) and (FMaxLen < 1) then
2029 begin
2030 FMaxLen := Width;
2031 if FMaxLen < 1 then
2032 FMaxLen := 1;
2033 end
2034 else
2035 if(Value = dftWP) then
2036 begin
2037 if (FMaxLen = 0) then
2038 FMaxLen := MAX_ENTRY_WIDTH
2039 else
2040 if (FMaxLen < 5) then
2041 FMaxLen := 5;
2042 if FTextLen < 2 then
2043 FTextLen := 2;
2044 end
2045 else
2046 if(Value = dftDate) and (FDateType = dtUnknown) then
2047 FDateType := dtDate;
2048 end;
2049end;
2050
2051procedure TTemplateField.SetID(const Value: string);
2052begin
2053// if(FID <> Value) and CanModify then
2054 FID := Value;
2055end;
2056
2057procedure TTemplateField.SetInactive(const Value: boolean);
2058begin
2059 if(FInactive <> Value) and CanModify then
2060 FInactive := Value;
2061end;
2062
2063procedure TTemplateField.SetItemDefault(const Value: string);
2064begin
2065 if(FItemDefault <> Value) and CanModify then
2066 FItemDefault := Value;
2067end;
2068
2069procedure TTemplateField.SetItems(const Value: string);
2070begin
2071 if(FItems <> Value) and CanModify then
2072 FItems := Value;
2073end;
2074
2075procedure TTemplateField.SetLMText(const Value: string);
2076begin
2077 if(FLMText <> Value) and CanModify then
2078 FLMText := Value;
2079end;
2080
2081procedure TTemplateField.SetMaxLen(const Value: integer);
2082begin
2083 if(FMaxLen <> Value) and CanModify then
2084 FMaxLen := Value;
2085end;
2086
2087procedure TTemplateField.SetNotes(const Value: string);
2088begin
2089 if(FNotes <> Value) and CanModify then
2090 FNotes := Value;
2091end;
2092
2093function TTemplateField.SaveError: string;
2094var
2095 TmpSL, FldSL: TStringList;
2096 AID,Res: string;
2097 idx, i: integer;
2098 IEN64: Int64;
2099 NewRec: boolean;
2100
2101begin
2102 if(FFldName = NewTemplateField) then
2103 begin
2104// Result := 'Template Field can not be named "' + NewTemplateField + '"'; <-- original line. //kt 8/8/2007
2105 Result := DKLangConstW('uTemplateFields_Template_Field_can_not_be_named_x') + NewTemplateField + '"'; //kt added 8/8/2007
2106 exit;
2107 end;
2108 Result := '';
2109 NewRec := (StrToIntDef(FID,0) < 0);
2110 if(FModified or NewRec) then
2111 begin
2112 TmpSL := TStringList.Create;
2113 try
2114 FldSL := TStringList.Create;
2115 try
2116 if(StrToIntDef(FID,0) > 0) then
2117 AID := FID
2118 else
2119 AID := '0';
2120 FldSL.Add('.01='+FFldName);
2121 FldSL.Add('.02='+TemplateFieldTypeCodes[FFldType]);
2122 FldSL.Add('.03='+BOOLCHAR[FInactive]);
2123 FldSL.Add('.04='+IntToStr(FMaxLen));
2124 FldSL.Add('.05='+FEditDefault);
2125 FldSL.Add('.06='+FLMText);
2126 idx := -1;
2127 if(FItems <> '') and (FItemDefault <> '') then
2128 begin
2129 TmpSL.Text := FItems;
2130 for i := 0 to TmpSL.Count-1 do
2131 if(FItemDefault = TmpSL[i]) then
2132 begin
2133 idx := i;
2134 break;
2135 end;
2136 end;
2137 FldSL.Add('.07='+IntToStr(Idx+1));
2138 FldSL.Add('.08='+BOOLCHAR[fRequired]);
2139 FldSL.Add('.09='+BOOLCHAR[fSepLines]);
2140 FldSL.Add('.1=' +IntToStr(FTextLen));
2141 FldSL.Add('.11='+IntToStr(FIndent));
2142 FldSL.Add('.12='+IntToStr(FPad));
2143 FldSL.Add('.13='+IntToStr(FMinVal));
2144 FldSL.Add('.14='+IntToStr(FMaxVal));
2145 FldSL.Add('.15='+IntToStr(FIncrement));
2146 if FDateType = dtUnknown then
2147 FldSL.Add('.16=@')
2148 else
2149 FldSL.Add('.16='+TemplateFieldDateCodes[FDateType]);
2150
2151 if FURL='' then
2152 FldSL.Add('3=@')
2153 else
2154 FldSL.Add('3='+FURL);
2155
2156 if(FNotes <> '') or (not NewRec) then
2157 begin
2158 if(FNotes = '') then
2159 FldSL.Add('2,1=@')
2160 else
2161 begin
2162 TmpSL.Text := FNotes;
2163 for i := 0 to TmpSL.Count-1 do
2164 FldSL.Add('2,'+IntToStr(i+1)+',0='+TmpSL[i]);
2165 end;
2166 end;
2167 if((FItems <> '') or (not NewRec)) then
2168 begin
2169 if(FItems = '') then
2170 FldSL.Add('10,1=@')
2171 else
2172 begin
2173 TmpSL.Text := FItems;
2174 for i := 0 to TmpSL.Count-1 do
2175 FldSL.Add('10,'+IntToStr(i+1)+',0='+TmpSL[i]);
2176 end;
2177 end;
2178
2179 Res := UpdateTemplateField(AID, FldSL);
2180 IEN64 := StrToInt64Def(Piece(Res,U,1),0);
2181 if(IEN64 > 0) then
2182 begin
2183 if(NewRec) then
2184 FID := IntToStr(IEN64)
2185 else
2186 UnlockTemplateField(FID);
2187 FModified := FALSE;
2188 FNameChanged := FALSE;
2189 FLocked := FALSE;
2190 end
2191 else
2192 Result := Piece(Res, U, 2);
2193 finally
2194 FldSL.Free;
2195 end;
2196 finally
2197 TmpSL.Free;
2198 end;
2199 end;
2200end;
2201
2202procedure TTemplateField.Assign(AFld: TTemplateField);
2203begin
2204 FMaxLen := AFld.FMaxLen;
2205 FFldName := AFld.FFldName;
2206 FLMText := AFld.FLMText;
2207 FEditDefault := AFld.FEditDefault;
2208 FNotes := AFld.FNotes;
2209 FItems := AFld.FItems;
2210 FInactive := AFld.FInactive;
2211 FItemDefault := AFld.FItemDefault;
2212 FFldType := AFld.FFldType;
2213 FRequired := AFld.FRequired;
2214 FSepLines := AFld.FSepLines;
2215 FTextLen := AFld.FTextLen;
2216 FIndent := AFld.FIndent;
2217 FPad := AFld.FPad;
2218 FMinVal := AFld.FMinVal;
2219 FMaxVal := AFld.FMaxVal;
2220 FIncrement := AFld.FIncrement;
2221 FDateType := AFld.FDateType;
2222 FURL := AFld.FURL;
2223end;
2224
2225function TTemplateField.Width: integer;
2226var
2227 i, ilen: integer;
2228 TmpSL: TStringList;
2229
2230begin
2231 if(FFldType = dftEditBox) then
2232 Result := FMaxLen
2233 else
2234 begin
2235 if FMaxLen > 0 then
2236 Result := FMaxLen
2237 else
2238 begin
2239 Result := -1;
2240 TmpSL := TStringList.Create;
2241 try
2242 TmpSL.Text := StripEmbedded(FItems);
2243 for i := 0 to TmpSL.Count-1 do
2244 begin
2245 ilen := length(TmpSL[i]);
2246 if(Result < ilen) then
2247 Result := ilen;
2248 end;
2249 finally
2250 TmpSL.Free;
2251 end;
2252 end;
2253 end;
2254 if Result > MaxTFEdtLen then
2255 Result := MaxTFEdtLen;
2256end;
2257
2258destructor TTemplateField.Destroy;
2259begin
2260 uTmplFlds.Remove(Self);
2261 inherited;
2262end;
2263
2264procedure TTemplateField.SetRequired(const Value: boolean);
2265begin
2266 if(FRequired <> Value) and CanModify then
2267 FRequired := Value;
2268end;
2269
2270function TTemplateField.NewField: boolean;
2271begin
2272 Result := (StrToIntDef(FID,0) <= 0);
2273end;
2274
2275procedure TTemplateField.SetSepLines(const Value: boolean);
2276begin
2277 if(FSepLines <> Value) and CanModify then
2278 FSepLines := Value
2279end;
2280
2281procedure TTemplateField.SetIncrement(const Value: integer);
2282begin
2283 if(FIncrement <> Value) and CanModify then
2284 FIncrement := Value;
2285end;
2286
2287procedure TTemplateField.SetIndent(const Value: integer);
2288begin
2289 if(FIndent <> Value) and CanModify then
2290 FIndent := Value;
2291end;
2292
2293procedure TTemplateField.SetMaxVal(const Value: integer);
2294begin
2295 if(FMaxVal <> Value) and CanModify then
2296 FMaxVal := Value;
2297end;
2298
2299procedure TTemplateField.SetMinVal(const Value: integer);
2300begin
2301 if(FMinVal <> Value) and CanModify then
2302 FMinVal := Value;
2303end;
2304
2305procedure TTemplateField.SetPad(const Value: integer);
2306begin
2307 if(FPad <> Value) and CanModify then
2308 FPad := Value;
2309end;
2310
2311procedure TTemplateField.SetTextLen(const Value: integer);
2312begin
2313 if(FTextLen <> Value) and CanModify then
2314 FTextLen := Value;
2315end;
2316
2317procedure TTemplateField.SetURL(const Value: string);
2318begin
2319 if(FURL <> Value) and CanModify then
2320 FURL := Value;
2321end;
2322
2323function TTemplateField.GetRequired: boolean;
2324begin
2325 if FFldType in NoRequired then
2326 Result := FALSE
2327 else
2328 Result := FRequired;
2329end;
2330
2331procedure TTemplateField.SetDateType(const Value: TTmplFldDateType);
2332begin
2333 if(FDateType <> Value) and CanModify then
2334 FDateType := Value;
2335end;
2336
2337{ TTemplateDialogEntry }
2338const
2339 EOL_MARKER = #182;
2340
2341procedure PanelDestroy(AData: Pointer; Sender: TObject);
2342var
2343 idx: integer;
2344 dlg: TTemplateDialogEntry;
2345
2346begin
2347 dlg := TTemplateDialogEntry(AData);
2348 idx := uEntries.IndexOf(dlg.FID);
2349 if(idx >= 0) then
2350 uEntries.Delete(idx);
2351 dlg.FPanelDying := TRUE;
2352 dlg.Free;
2353end;
2354
2355constructor TTemplateDialogEntry.Create(AParent: TWinControl; AID, Text: string);
2356var
2357 CtrlID, idx, i, j, flen: integer;
2358 txt, FldName: string;
2359 Fld: TTemplateField;
2360
2361begin
2362 FID := AID;
2363 FText := Text;
[654]2364 FHTMLMode := false; //kt added 12/28/09
[453]2365 FControls := TStringList.Create;
2366 FIndents := TStringList.Create;
2367 FFont := TFont.Create;
2368 FFont.Assign(TORExposedControl(AParent).Font);
2369 FControls.Text := Text;
2370 if(FControls.Count > 1) then
2371 for i := 1 to FControls.Count-1 do
2372 FControls[i] := EOL_MARKER + FControls[i];
2373 FFirstBuild := TRUE;
2374 FPanel := TFieldPanel.Create(AParent.Owner);
2375 FPanel.Parent := AParent;
2376 FPanel.BevelOuter := bvNone;
2377 FPanel.Caption := '';
2378 FPanel.Font.Assign(FFont);
2379 idx := 0;
2380 while (idx < FControls.Count) do
2381 begin
2382 txt := FControls[idx];
2383 i := pos(TemplateFieldBeginSignature, txt);
2384 if(i > 0) then
2385 begin
2386 if(copy(txt, i + TemplateFieldSignatureLen, 1) = FieldIDDelim) then
2387 begin
2388 CtrlID := StrToIntDef(copy(txt, i + TemplateFieldSignatureLen + 1, FieldIDLen-1), 0);
2389 delete(txt,i + TemplateFieldSignatureLen, FieldIDLen);
2390 end
2391 else
2392 CtrlID := 0;
2393 j := pos(TemplateFieldEndSignature, copy(txt, i + TemplateFieldSignatureLen, MaxInt));
2394 if(j > 0) then
2395 begin
2396 inc(j, i + TemplateFieldSignatureLen - 1);
2397 flen := j - i - TemplateFieldSignatureLen;
2398 FldName := copy(txt, i + TemplateFieldSignatureLen, flen);
2399 Fld := GetTemplateField(FldName, FALSE);
2400 delete(txt,i,flen + TemplateFieldSignatureLen + 1);
2401 if(assigned(Fld)) then
2402 begin
2403 FControls[idx] := copy(txt,1,i-1);
2404 if(Fld.Required) then
2405 FControls[idx] := FControls[idx] + '*';
2406 Fld.CreateDialogControls(Self, idx, CtrlID);
2407 FControls.Insert(idx+1,copy(txt,i,MaxInt));
2408 end
2409 else
2410 begin
2411 FControls[idx] := txt;
2412 dec(idx);
2413 end;
2414 end
2415 else
2416 begin
2417 delete(txt,i,TemplateFieldSignatureLen);
2418 FControls[idx] := txt;
2419 dec(idx);
2420 end;
2421 end;
2422 inc(idx);
2423 end;
2424end;
2425
2426destructor TTemplateDialogEntry.Destroy;
2427begin
2428 if assigned(FOnDestroy) then
2429 FOnDestroy(Self);
2430 KillLabels;
2431 KillObj(@FControls, TRUE);
2432 if FPanelDying then
2433 FPanel := nil
2434 else
2435 FreeAndNil(FPanel);
2436 FreeAndNil(FFont);
2437 FreeAndNil(FIndents);
2438 inherited;
2439end;
2440
2441procedure TTemplateDialogEntry.DoChange(Sender: TObject);
2442begin
2443 if (not FUpdating) and assigned(FOnChange) then
2444 FOnChange(Self);
2445end;
2446
2447function TTemplateDialogEntry.GetControlText(CtrlID: integer; NoCommas: boolean;
2448 var FoundEntry: boolean; AutoWrap: boolean;
2449 emField: string = ''): string;
2450var
2451 x, i, j, ind, idx: integer;
2452 Ctrl: TControl;
2453 Done: boolean;
2454 iString: string;
2455 iField: TTemplateField;
2456 iTemp: TStringList;
2457
2458 function GetOriginalItem(istr: string): string;
2459 begin
2460 Result := '';
2461 if emField <> '' then
2462 begin
2463 iField := GetTemplateField(emField,FALSE);
2464 iTemp := nil;
2465 if ifield <> nil then
2466 try
2467 iTemp := TStringList.Create;
2468 iTemp.Text := StripEmbedded(iField.Items);
2469 x := iTemp.IndexOf(istr);
2470 if x >= 0 then
2471 begin
2472 iTemp.Text := iField.Items;
2473 Result := iTemp.Strings[x];
2474 end;
2475 finally
2476 iTemp.Free;
2477 end;
2478 end;
2479 end;
2480
2481
2482begin
2483 Result := '';
2484 Done := FALSE;
2485 ind := -1;
2486 for i := 0 to FControls.Count-1 do
2487 begin
2488 Ctrl := TControl(FControls.Objects[i]);
2489 if(assigned(Ctrl)) and (Ctrl.Tag = CtrlID) then
2490 begin
2491 FoundEntry := TRUE;
2492 Done := TRUE;
2493 if ind < 0 then
2494 begin
2495 idx := FIndents.IndexOfObject(Ctrl);
2496 if idx >= 0 then
2497 ind := StrToIntDef(Piece(FIndents[idx], U, 2), 0)
2498 else
2499 ind := 0;
2500 end;
2501 if(Ctrl is TFieldLabel) then
2502 begin
2503 if not TFieldLabel(Ctrl).Exclude then begin
2504 if emField <> '' then begin
2505 iField := GetTemplateField(emField,FALSE);
2506 case iField.FldType of
2507 dftHyperlink: if iField.EditDefault <> '' then
2508 Result := iField.EditDefault
2509 else
2510 Result := iField.URL;
2511 dftText: begin
2512 iString := iField.Items;
2513 if copy(iString,length(iString)-1,2) = CRLF then
2514 delete(iString,length(iString)-1,2);
2515 Result := iString;
2516 end;
2517 else {case}
2518 Result := TFieldLabel(Ctrl).Caption
2519 end; {case iField.FldType}
2520 end {if emField}
2521 else
2522 Result := TFieldLabel(Ctrl).Caption;
2523 end;
2524 end
2525 else
2526 if(Ctrl is TEdit) then
2527 Result := TEdit(Ctrl).Text
2528 else
2529 if(Ctrl is TORComboBox) then begin
2530 Result := TORComboBox(Ctrl).Text;
2531 iString := GetOriginalItem(Result);
2532 if iString <> '' then
2533 Result := iString;
2534 end
2535 else
2536 if(Ctrl is TORDateCombo) then
2537 Result := TORDateCombo(Ctrl).Text + ':' + FloatToStr(TORDateCombo(Ctrl).FMDate)
2538 else
2539 if(Ctrl is TORDateBox) then
2540 Result := TORDateBox(Ctrl).Text
2541 else
2542 if(Ctrl is TRichEdit) then
2543 begin
2544 if((ind = 0) and (not AutoWrap)) then
2545 Result := TRichEdit(Ctrl).Lines.Text
2546 else
2547 begin
2548 for j := 0 to TRichEdit(Ctrl).Lines.Count-1 do
2549 begin
2550 if AutoWrap then
2551 begin
2552 if(Result <> '') then
2553 Result := Result + ' ';
2554 Result := Result + TRichEdit(Ctrl).Lines[j];
2555 end
2556 else
2557 begin
2558 if(Result <> '') then
2559 Result := Result + CRLF;
2560 Result := Result + StringOfChar(' ', ind) + TRichEdit(Ctrl).Lines[j];
2561 end;
2562 end;
2563 ind := 0;
2564 end;
2565 end
2566 else
2567 if(Ctrl is TORCheckBox) then
2568 begin
2569 Done := FALSE;
2570 if(TORCheckBox(Ctrl).Checked) then
2571 begin
2572 if(Result <> '') then
2573 begin
2574 if NoCommas then
2575 Result := Result + '|'
2576 else
2577 Result := Result + ', ';
2578 end;
2579 iString := GetOriginalItem(TORCheckBox(Ctrl).Caption);
2580 if iString <> '' then
2581 Result := Result + iString
2582 else
2583 Result := Result + TORCheckBox(Ctrl).Caption;
2584 end;
2585 end
2586 else
2587 if(Ctrl is TfraTemplateFieldButton) then
2588 begin
2589 Result := TfraTemplateFieldButton(Ctrl).ButtonText;
2590 iString := GetOriginalItem(Result);
2591 if iString <> '' then
2592 Result := iString;
2593 end
2594 else
2595 if(Ctrl is TPanel) then
2596 begin
2597 for j := 0 to Ctrl.ComponentCount-1 do
2598 if Ctrl.Components[j] is TUpDown then
2599 begin
2600 Result := IntToStr(TUpDown(Ctrl.Components[j]).Position);
2601 break;
2602 end;
2603 end;
2604 end;
2605 if Done then break;
2606 end;
2607 if (ind > 0) and (not NoCommas) then
2608 Result := StringOfChar(' ', ind) + Result;
2609end;
2610
2611function TTemplateDialogEntry.GetFieldValues: string;
2612var
2613 i: integer;
2614 Ctrl: TControl;
2615 CtrlID: integer;
2616 TmpIDs: TList;
2617 TmpSL: TStringList;
2618 Dummy: boolean;
2619
2620begin
2621 Result := '';
2622 TmpIDs := TList.Create;
2623 try
2624 TmpSL := TStringList.Create;
2625 try
2626 for i := 0 to FControls.Count-1 do
2627 begin
2628 Ctrl := TControl(FControls.Objects[i]);
2629 if(assigned(Ctrl)) then
2630 begin
2631 CtrlID := Ctrl.Tag;
2632 if(TmpIDs.IndexOf(Pointer(CtrlID)) < 0) then
2633 begin
2634 TmpSL.Add(IntToStr(CtrlID) + U + GetControlText(CtrlID, TRUE, Dummy, FALSE));
2635 TmpIDs.Add(Pointer(CtrlID));
2636 end;
2637 end;
2638 end;
2639 Result := TmpSL.CommaText;
2640 finally
2641 TmpSL.Free;
2642 end;
2643 finally
2644 TmpIDs.Free;
2645 end;
2646end;
2647
2648function TTemplateDialogEntry.GetPanel(MaxLen: integer; AParent: TWinControl): TPanel;
2649var
2650 i, x, y, cnt, idx, ind, yinc, ybase, MaxX: integer;
2651 MaxTextLen: integer; {Max num of chars per line in pixels}
2652 MaxChars: integer; {Max num of chars per line}
2653 txt: string;
2654 ctrl: TControl;
2655 LastLineBlank: boolean;
2656const
2657 FOCUS_RECT_MARGIN = 2; {The margin around the panel so the label won't
2658 overlay the focus rect on its parent panel.}
2659 procedure DoLabel(Atxt: string);
2660 var
2661 lbl: TLabel;
2662
2663 begin
2664 lbl := TLabel.Create(nil);
2665 lbl.Parent := FPanel;
2666 lbl.ShowAccelChar := FALSE;
2667 lbl.Caption := Atxt;
2668 lbl.Left := x;
2669 lbl.Top := y;
2670 inc(x, lbl.Width);
2671 end;
2672
2673 procedure NextLine;
2674 begin
2675 if(MaxX < x) then
2676 MaxX := x;
2677 x := FOCUS_RECT_MARGIN; {leave two pixels on the left for the Focus Rect}
2678 inc(y, yinc);
2679 yinc := ybase;
2680 end;
2681
2682begin
2683 MaxTextLen := MaxLen - (FOCUS_RECT_MARGIN * 2);{save room for the focus rectangle on the panel}
2684 if(FFirstBuild or (FPanel.Width <> MaxLen)) then
2685 begin
2686 if(FFirstBuild) then
2687 FFirstBuild := FALSE
2688 else
2689 KillLabels;
2690 y := FOCUS_RECT_MARGIN; {placement of labels on panel so they don't cover the}
2691 x := FOCUS_RECT_MARGIN; {focus rectangle}
2692 MaxX := 0;
2693 //ybase := FontHeightPixel(FFont.Handle) + 1 + (FOCUS_RECT_MARGIN * 2); AGP commentout line for
2694 //reminder spacing
2695 ybase := FontHeightPixel(FFont.Handle);
2696 yinc := ybase;
2697 LastLineBlank := FALSE;
2698 for i := 0 to FControls.Count-1 do
2699 begin
2700 txt := FControls[i];
2701 if(copy(txt,1,1) = EOL_MARKER) then
2702 begin
2703 if((x <> 0) or LastLineBlank) then
2704 NextLine;
2705 delete(txt,1,1);
2706 LastLineBlank := (txt = '');
2707 end;
2708 if(txt <> '') then
2709 begin
2710 while(txt <> '') do
2711 begin
2712 cnt := NumCharsFitInWidth(FFont.Handle, txt, MaxTextLen-x);
2713 MaxChars := cnt;
2714 if(cnt >= length(txt)) then
2715 begin
2716 DoLabel(txt);
2717 txt := '';
2718 end
2719 else
2720 if(cnt < 1) then
2721 NextLine
2722 else
2723 begin
2724 repeat
2725 if(txt[cnt+1] = ' ') then
2726 begin
2727 DoLabel(copy(txt,1,cnt));
2728 NextLine;
2729 txt := copy(txt, cnt + 1, MaxInt);
2730 break;
2731 end
2732 else
2733 dec(cnt);
2734 until(cnt = 0);
2735 if(cnt = 0) then
2736 begin
2737 if(x = FOCUS_RECT_MARGIN) then {If x is at the far left margin...}
2738 begin
2739 DoLabel(Copy(txt,1,MaxChars));
2740 NextLine;
2741 txt := copy(txt, MaxChars + 1, MaxInt);
2742 end
2743 else
2744 NextLine;
2745 end;
2746 end;
2747 end;
2748 end
2749 else
2750 begin
2751 ctrl := TControl(FControls.Objects[i]);
2752 if(assigned(ctrl)) then
2753 begin
2754 idx := FIndents.IndexOfObject(Ctrl);
2755 if idx >= 0 then
2756 ind := StrToIntDef(Piece(FIndents[idx], U, 1), 0)
2757 else
2758 ind := 0;
2759 if(x > 0) then
2760 begin
2761 if (x < MaxLen) and (Ctrl is TORCheckBox) and (TORCheckBox(Ctrl).StringData = NewLine) then
2762 x := MaxLen;
2763 if((ctrl.Width + x + ind) > MaxLen) then
2764 NextLine;
2765 end;
2766 inc(x,ind);
2767 Ctrl.Left := x;
2768 Ctrl.Top := y;
2769 inc(x, Ctrl.Width + 4);
2770 if yinc <= Ctrl.Height then
2771 yinc := Ctrl.Height + 1;
2772 if (x < MaxLen) and ((Ctrl is TRichEdit) or
2773 ((Ctrl is TLabel) and (pos(CRLF, TLabel(Ctrl).Caption) > 0))) then
2774 x := MaxLen;
2775 end;
2776 end;
2777 end;
2778 NextLine;
2779 FPanel.Height := (y-1) + (FOCUS_RECT_MARGIN * 2); //AGP added Focus_rect_margin for Reminder spacing
2780 FPanel.Width := MaxX + FOCUS_RECT_MARGIN;
2781 end;
2782 if(FFieldValues <> '') then
2783 SetFieldValues(FFieldValues);
2784 Result := FPanel;
2785end;
2786
[654]2787procedure TTemplateDialogEntry.SetAnswerHTMLTag(Value : string);
2788//kt 12/28/09 Added entire function
2789begin
2790 if Value='' then begin
2791 FAnswerOpenTag :='';
2792 FAnswerCloseTag := '';
2793 end else begin
2794 if Pos('<',Value)>0 then Value := Piece(Value,'<',2);
2795 if Pos('>',Value)>0 then Value := Piece(Value,'>',1);
2796 FAnswerOpenTag :='<'+Value+'>';
2797 FAnswerCloseTag := '</' + Value + '>';
2798 end;
2799end;
2800
[453]2801function TTemplateDialogEntry.GetText: string;
2802begin
[654]2803 //kt Result := ResolveTemplateFields(FText, FALSE);
2804 Result := ResolveTemplateFields(FText, FALSE, FALSE, FALSE, FHTMLMode, FAnswerOpenTag, FAnswerCloseTag); //kt 12/29/09
[453]2805end;
2806
2807procedure TTemplateDialogEntry.KillLabels;
2808var
2809 i, idx: integer;
2810 obj: TObject;
2811
2812begin
2813 if(assigned(FPanel)) then
2814 begin
2815 for i := FPanel.ControlCount-1 downto 0 do
2816 if(FPanel.Controls[i] is TLabel) then
2817 begin
2818 obj := FPanel.Controls[i];
2819 idx := FControls.IndexOfObject(obj);
2820 if idx < 0 then
2821 obj.Free;
2822 end;
2823 end;
2824end;
2825
2826procedure TTemplateDialogEntry.SetAutoDestroyOnPanelFree(
2827 const Value: boolean);
2828var
2829 M: TMethod;
2830
2831begin
2832 FAutoDestroyOnPanelFree := Value;
2833 if(Value) then
2834 begin
2835 M.Data := Self;
2836 M.Code := @PanelDestroy;
2837 TFieldPanel(FPanel).OnDestroy := TNotifyEvent(M);
2838 end
2839 else
2840 TFieldPanel(FPanel).OnDestroy := nil;
2841end;
2842
2843procedure TTemplateDialogEntry.SetControlText(CtrlID: integer; AText: string);
2844var
2845 cnt, i, j: integer;
2846 Ctrl: TControl;
2847 Done: boolean;
2848
2849begin
2850 FUpdating := TRUE;
2851 try
2852 Done := FALSE;
2853 cnt := 0;
2854 for i := 0 to FControls.Count-1 do
2855 begin
2856 Ctrl := TControl(FControls.Objects[i]);
2857 if(assigned(Ctrl)) and (Ctrl.Tag = CtrlID) then
2858 begin
2859 Done := TRUE;
2860 if(Ctrl is TLabel) then
2861 TLabel(Ctrl).Caption := AText
2862 else
2863 if(Ctrl is TEdit) then
2864 TEdit(Ctrl).Text := AText
2865 else
2866 if(Ctrl is TORComboBox) then
2867 TORComboBox(Ctrl).SelectByID(AText)
2868 else
2869 if(Ctrl is TRichEdit) then
2870 TRichEdit(Ctrl).Lines.Text := AText
2871 else
2872 if(Ctrl is TORDateCombo) then
2873 TORDateCombo(Ctrl).FMDate := MakeFMDateTime(piece(AText,':',2))
2874 else
2875 if(Ctrl is TORDateBox) then
2876 TORDateBox(Ctrl).Text := AText
2877 else
2878 if(Ctrl is TORCheckBox) then
2879 begin
2880 Done := FALSE;
2881 if(cnt = 0) then
2882 cnt := DelimCount(AText, '|') + 1;
2883 for j := 1 to cnt do
2884 begin
2885 if(TORCheckBox(Ctrl).Caption = piece(AText,'|',j)) then
2886 TORCheckBox(Ctrl).Checked := TRUE;
2887 end;
2888 end
2889 else
2890 if(Ctrl is TfraTemplateFieldButton) then
2891 TfraTemplateFieldButton(Ctrl).ButtonText := AText
2892 else
2893 if(Ctrl is TPanel) then
2894 begin
2895 for j := 0 to Ctrl.ComponentCount-1 do
2896 if Ctrl.Components[j] is TUpDown then
2897 begin
2898 TUpDown(Ctrl.Components[j]).Position := StrToIntDef(AText,0);
2899 break;
2900 end;
2901 end;
2902 end;
2903 if Done then break;
2904 end;
2905 finally
2906 FUpdating := FALSE;
2907 end;
2908end;
2909
2910procedure TTemplateDialogEntry.SetFieldValues(const Value: string);
2911var
2912 i: integer;
2913 TmpSL: TStringList;
2914
2915begin
2916 FFieldValues := Value;
2917 TmpSL := TStringList.Create;
2918 try
2919 TmpSL.CommaText := Value;
2920 for i := 0 to TmpSL.Count-1 do
2921 SetControlText(StrToIntDef(Piece(TmpSL[i], U, 1), 0), Piece(TmpSL[i], U, 2));
2922 finally
2923 TmpSL.Free;
2924 end;
2925end;
2926
2927procedure TTemplateDialogEntry.UpDownChange(Sender: TObject);
2928begin
2929 EnsureText(TEdit(Sender), TUpDown(TEdit(Sender).Tag));
2930 DoChange(Sender);
2931end;
2932
2933{ TFieldPanel }
2934
2935destructor TFieldPanel.Destroy;
2936begin
2937 if(assigned(FOnDestroy)) then
2938 FOnDestroy(Self);
2939 inherited;
2940end;
2941
2942{intercept the paint event to draw the focus rect if FFocused is true}
2943function TFieldPanel.GetFocus: boolean;
2944begin
2945 result := Focused;
2946end;
2947
2948procedure TFieldPanel.Paint;
2949var
2950 DC: HDC;
2951 R: TRect;
2952
2953begin
2954 inherited;
2955 if(Focused) then
2956 begin
2957 if(not assigned(FCanvas)) then
2958 FCanvas := TControlCanvas.Create;
2959 DC := GetWindowDC(Handle);
2960 try
2961 FCanvas.Handle := DC;
2962 R := ClientRect;
2963 InflateRect(R, -1, -1);
2964 FCanvas.DrawFocusRect(R);
2965 finally
2966 ReleaseDC(Handle, DC);
2967 end;
2968 end;
2969end;
2970
2971procedure TFieldPanel.SetTheFocus(const Value: boolean);
2972begin
2973 if Value then
2974 SetFocus;
2975end;
2976
2977{ TWebLabel }
2978
2979procedure TWebLabel.Clicked(Sender: TObject);
2980begin
2981 GotoWebPage(FAddr);
2982end;
2983
2984procedure TWebLabel.Init(Addr: string);
2985begin
2986 FAddr := Addr;
2987 OnClick := Clicked;
2988 Font.Assign(TORExposedControl(Parent).Font);
2989 Font.Color := clActiveCaption;
2990 Font.Style := Font.Style + [fsUnderline];
2991 AdjustBounds; // make sure we have the right width
2992 AutoSize := FALSE;
2993 Height := Height + 1; // Courier New doesn't support underline unless it's higher
2994 Cursor := crHandPoint;
2995end;
2996
2997function StripEmbedded(iItems: string): string;
2998{7/26/01 S Monson
2999 Returns the field will all embedded fields removed}
3000var
3001 p1, p2, icur: integer;
3002Begin
3003 p1 := pos(TemplateFieldBeginSignature,iItems);
3004 icur := 0;
3005 while p1 > 0 do
3006 begin
3007 p2 := pos(TemplateFieldEndSignature,copy(iItems,icur+p1+TemplateFieldSignatureLen,maxint));
3008 if p2 > 0 then
3009 begin
3010 delete(iItems,p1+icur,TemplateFieldSignatureLen+p2+TemplateFieldSignatureEndLen-1);
3011 icur := icur + p1 - 1;
3012 p1 := pos(TemplateFieldBeginSignature,copy(iItems,icur+1,maxint));
3013 end
3014 else
3015 p1 := 0;
3016 end;
3017 Result := iItems;
3018end;
3019
[729]3020function EvaluateFormula(formula : string): string;
3021begin
3022//CloseCharPos(OpenChar, CloseChar : char; var Txt : string; StartingPos : integer=1) : integer;
3023end;
3024
[735]3025function FormatFormula(test: string): string;
3026var
3027 test2: string;
3028 i: integer;
3029begin
3030 for i := 1 to length(test) do begin
3031 if test[i] in ['0'..'9','+','-','*','/','(',')','^'] then begin
3032 test2 := test2 + test[i];
3033 end;
3034 end;
3035 Result := test2;
3036end;
3037
[453]3038initialization
3039
3040finalization
3041 KillObj(@uTmplFlds, TRUE);
3042 KillObj(@uEntries, TRUE);
3043
3044end.
Note: See TracBrowser for help on using the repository browser.