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

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

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