source: cprs/branches/tmg-cprs/CPRS-Chart/Templates/uTemplates.pas@ 654

Last change on this file since 654 was 654, checked in by Kevin Toppenberg, 14 years ago

Added HTML templating
File size: 94.0 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit uTemplates;
3
4{$O-}
5
6interface
7uses
8 Classes, Controls, SysUtils, Forms, ORFn, ORNet, Dialogs, MSXML_TLB, uTIU, uDCSumm, Variants;
9
10type
11 TTemplateType = (ttNone, ttMyRoot, ttRoot, ttTitles, ttConsults, ttProcedures,
12 ttClass, ttDoc, ttGroup, ttDocEx, ttGroupEx);
13 TTemplateLinkTypes = ttTitles..ttProcedures;
14
15const
16 AllTemplateLinkTypes = [ttTitles..ttProcedures];
17 AllTemplateRootTypes = [ttMyRoot, ttRoot, ttTitles, ttConsults, ttProcedures];
18 AllTemplateTrueTypes = AllTemplateRootTypes + [ttNone, ttClass];
19 AllTemplateFolderTypes = AllTemplateRootTypes + [ttGroup, ttClass];
20
21type
22 TTemplateChildren = (tcNone, tcActive, tcInactive, tcBoth);
23 TTemplateAccess = (taAll, taReadOnly, taNone, taEditor);
24 TTemplateLinkType = (ltNone, ltTitle, ltConsult, ltProcedure);
25
26 TTemplateBackup = record
27 BPrintName: string;
28 BGap: integer;
29 BRealType: TTemplateType;
30 BActive: boolean;
31 BDisplayOnly: boolean;
32 BFirstLine: boolean;
33 BOneItemOnly: boolean;
34 BHideDlgItems: boolean;
35 BHideItems: boolean;
36 BIndentItems: boolean;
37 BExclude: boolean;
38 BDialog: boolean;
39 BPersonalOwner: Int64;
40 BBoilerPlate: string;
41 BItemIENs: string;
42 BDescription: string;
43 BReminderDialog: string;
44 BLock: boolean;
45 BCOMObject: integer;
46 BCOMParam: string;
47 BFileLink: string;
48
49 SavedPrintName: boolean;
50 SavedGap: boolean;
51 SavedRealType: boolean;
52 SavedActive: boolean;
53 SavedDisplayOnly: boolean;
54 SavedFirstLine: boolean;
55 SavedOneItemOnly: boolean;
56 SavedHideDlgItems: boolean;
57 SavedHideItems: boolean;
58 SavedIndentItems: boolean;
59 SavedExclude: boolean;
60 SavedDialog: boolean;
61 SavedPersonalOwner: boolean;
62 SavedBoilerPlate: boolean;
63 SavedItemIENs: boolean;
64 SavedDescription: boolean;
65 SavedReminderDialog: boolean;
66 SavedLock: boolean;
67 SavedCOMObject: boolean;
68 SavedCOMParam: boolean;
69 SavedFileLink: boolean;
70 end;
71
72 TTemplate = class(TObject)
73 private
74 FDescriptionLoaded: boolean; // Template Notes Loaded Flag
75 FDescription: string; // Template Notes
76 FCreatingChildren: boolean; // Flag used to prevent infinite recursion
77 FExclude: boolean; // Exclude from group boilerplate
78 FActive: boolean;
79 FDisplayOnly: boolean; // Suppresses checkbox in dialog - no PN text
80 FFirstLine: boolean; // Display only the first line in a dialog box
81 FOneItemOnly: boolean; // Allow only one Child Item to be selected in dialog
82 FHideDlgItems: boolean; // Hide Child Items when not checked
83 FHideItems: boolean; // Hide items in Templates Drawer Tree
84 FIndentItems: boolean; // Indent Items in dialog only
85 FLock: boolean; // Locks Shared Templates
86 FDialog: boolean; // Determines if Group is a Dialog
87 FBoilerPlateLoaded: boolean; // Boilerplate Loaded Flag
88 FBoilerplate: string; // Boilerplate
89 FID: string; // Template IEN
90 FPrintName: string; // Template Name
91 FItems: TList; // Holds pointers to children templates
92 FNodes: TStringList; // Holds tree nodes that reference the template
93 // string value is tmp index used for syncing
94 FRealType: TTemplateType; // Real Template Type (from the template file)
95 FGap: integer; // Number of blank lines to insert between items
96 FChildren: TTemplateChildren; // flag indicating the active status of children
97 FPersonalOwner: Int64; // owner DUZ
98 FExpanded: boolean; // Indicates children have been read from server
99 FTag: longint; // Used internally for syncing
100 FLastTagIndex: longint; // Used internally for syncing
101 FBkup: TTemplateBackup; // Backup values to determine what needs to be saved
102 FLastDlgCnt: longint;
103 FLastUniqueID: longint;
104 FDialogAborted: boolean; // Flag indicating Cancel was pressed on the dialog
105 FReminderDialog: string; // Reminder Dialog IEN ^ Reminder Dialog Name
106 FIsReminderDialog: boolean; // Flag used internally for setting Type
107 FIsCOMObject: boolean; // Flag used internally for setting Type
108 FLocked: boolean; // Flag Indicating Template is locked
109 FCOMObject: integer; // COM Object IEN
110 FCOMParam: string; // Param to pass to COM Object
111 FFileLink: string; // Used to link templates to Titles and Reasons for Request
112 FLinkName: string;
113 FCloning: boolean; // Flag used to prevent locking during the cloning process
114 FPreviewMode: boolean; // Flag to prevent "Are you sure you want to cancel?" dialog when previewing
115 protected
116 function TrueClone: TTemplate;
117 function GetItems: TList;
118 function GetTemplateType: TTemplateType;
119 function GetBoilerplate: string;
120 function GetChildren: TTemplateChildren;
121 procedure SetTemplateType(const Value: TTemplateType);
122 procedure SetBoilerplate(Value: string);
123 function GetText: string;
124 procedure SetPersonalOwner(Value: Int64);
125 procedure SetActive(const Value: boolean);
126 procedure SetDisplayOnly(const Value: boolean);
127 procedure SetFirstLine(const Value: boolean);
128 procedure SetOneItemOnly(const Value: boolean);
129 procedure SetHideDlgItems(const Value: boolean);
130 procedure SetHideItems(const Value: boolean);
131 procedure SetIndentItems(const Value: boolean);
132 procedure SetLock(const Value: boolean);
133 procedure SetExclude(const Value: boolean);
134 procedure SetDialog(const Value: boolean);
135 procedure SetGap(const Value: integer);
136 procedure SetPrintName(const Value: string);
137 procedure SetRealType(const Value: TTemplateType);
138 procedure ClearBackup(ClearItemIENs: boolean = TRUE);
139 procedure SetDescription(const Value: string);
140 function GetDescription: string;
141 function GetDialogAborted: boolean;
142 procedure SetReminderDialog(const Value: string); // Reminder Dialog IEN
143 procedure SetCOMObject(const Value: integer);
144 procedure SetCOMParam(const Value: string);
145 procedure AssignFileLink(const Value: string; Force: boolean);
146 procedure SetFileLink(const Value: string);
147 function ValidID: boolean;
148 public
149 constructor Create(DataString: string);
150 class function CreateFromXML(Element: IXMLDOMNode; Owner: string): TTemplate;
151 destructor Destroy; override;
152 function CanModify: boolean;
153 procedure Unlock;
154 procedure AddNode(Node: Pointer);
155 procedure RemoveNode(Node: Pointer);
156 procedure AddChild(Child: TTemplate);
157 procedure RemoveChild(Child: TTemplate);
158 function Clone(Owner: Int64): TTemplate;
159 function ItemBoilerplate: string;
160 function FullBoilerplate: string;
161 function ItemIENs: string;
162 procedure BackupItems;
163 procedure SortChildren;
164 function Changed: boolean;
165 function DialogProperties(Parent: TTemplate = nil): string;
166 function DlgID: string;
167 function IsDialog: boolean;
168 function CanExportXML(Data, Fields: TStringList; IndentLevel: integer = 0): boolean;
169 function ReminderDialogIEN: string;
170 function ReminderDialogName: string;
171 function ReminderWipe: string; //AGP Change 24.8
172 function IsLocked: boolean;
173 procedure UpdateImportedFieldNames(List: TStrings);
174 //function COMObjectText(const DefText: string = ''; DocInfo: string = ''): string;
175 function COMObjectText(DefText: string; var DocInfo: string): string;
176 function AutoLock: boolean;
177 function LinkType: TTemplateLinkType;
178 function LinkIEN: string;
179 function LinkName: string;
180 procedure ExecuteReminderDialog(OwningForm: TForm);
181 property Nodes: TStringList read FNodes;
182 property ID: string read FID;
183 property PrintName: string read FPrintName write SetPrintName;
184 property RealType: TTemplateType read FRealType write SetRealType;
185 property TemplateType: TTemplateType read GetTemplateType write SetTemplateType;
186 property Active: boolean read FActive write SetActive;
187 property DisplayOnly: boolean read FDisplayOnly write SetDisplayOnly;
188 property FirstLine: boolean read FFirstLine write SetFirstLine;
189 property OneItemOnly: boolean read FOneItemOnly write SetOneItemOnly;
190 property HideDlgItems: boolean read FHideDlgItems write SetHideDlgItems;
191 property HideItems: boolean read FHideItems write SetHideItems;
192 property IndentItems: boolean read FIndentItems write SetIndentItems;
193 property Lock: boolean read FLock write SetLock;
194 property Exclude: boolean read FExclude write SetExclude;
195 property Dialog: boolean read FDialog write SetDialog;
196 property Boilerplate: string read GetBoilerplate write SetBoilerplate;
197 property Children: TTemplateChildren read GetChildren;
198 property Items: TList read GetItems;
199 property Gap: integer read FGap write SetGap;
200 property Description: string read GetDescription write SetDescription;
201 property Text: string read GetText;
202 property PersonalOwner: Int64 read FPersonalOwner write SetPersonalOwner;
203 property Expanded: boolean read FExpanded write FExpanded;
204 property Tag: longint read FTag write FTag;
205 property LastTagIndex: longint read FLastTagIndex write FLastTagIndex;
206 property DialogAborted: boolean read GetDialogAborted;
207 property ReminderDialog: string read FReminderDialog write SetReminderDialog;
208 property IsReminderDialog: boolean read FIsReminderDialog write FIsReminderDialog;
209 property IsCOMObject: boolean read FIsCOMObject write FIsCOMObject;
210 property Locked: boolean read FLocked;
211 property COMObject: integer read FCOMObject write SetCOMObject;
212 property COMParam: string read FCOMParam write SetCOMParam;
213 property FileLink: string read FFileLink write SetFileLink;
214 property TemplatePreviewMode: boolean read FPreviewMode write FPreviewMode;
215 end;
216
217function SearchMatch(const SubStr, Str: string; const WholeWordsOnly: boolean): boolean;
218function UserTemplateAccessLevel: TTemplateAccess;
219function AddTemplate(DataString: string; Owner: TTemplate = nil): TTemplate;
220procedure LoadTemplateData;
221procedure ExpandTemplate(tmpl: TTemplate);
222procedure ReleaseTemplates;
223procedure RemoveAllNodes;
224function CanEditLinkType(LinkType: TTemplateLinkTypes): boolean;
225function GetLinkedTemplate(IEN: string; LType: TTemplateLinkType): TTemplate;
226function ConvertFileLink(IEN: string; LType: TTemplateLinkType): string;
227function GetLinkName(IEN: string; LType: TTemplateLinkType): string;
228
229function BackupDiffers: boolean;
230procedure SaveTemplate(Template: TTemplate; Idx: integer; ErrorList: TStrings = nil);
231function SaveAllTemplates: boolean;
232procedure ClearBackup;
233procedure MarkDeleted(Template: TTemplate);
234function BadTemplateName(Text: string): boolean;
235procedure WordImportError(msg: string);
236procedure XMLImportError(Result: HResult);
237procedure XMLImportCheck(Result: HResult);
238function GetXMLFromWord(const AFileName: string; Data: TStrings): boolean;
239function WordImportActive: boolean;
240procedure UnlockAllTemplates;
241function DisplayGroupToLinkType(DGroup: integer): TTemplateLinkType;
242
243(*procedure ExecuteTemplateOrBoilerPlate(SL: TStrings; IEN: Integer; LType: TTemplateLinkType;
244 OwningForm: TForm; const CaptionText: string = ''; DocInfo: string = ''); overload;
245procedure ExecuteTemplateOrBoilerPlate(var AText: string; IEN: Integer; LType: TTemplateLinkType;
246 OwningForm: TForm; const CaptionText: string = ''; DocInfo: string = ''); overload;*)
247procedure ExecuteTemplateOrBoilerPlate(SL: TStrings; IEN: Integer; LType: TTemplateLinkType;
248 OwningForm: TForm; CaptionText: string; var DocInfo: string); overload;
249procedure ExecuteTemplateOrBoilerPlate(var AText: string; IEN: Integer; LType: TTemplateLinkType;
250 OwningForm: TForm; CaptionText: string; var DocInfo: string); overload;
251
252procedure ExpandEmbeddedFields(flds: TStringList);
253function MakeXMLParamTIU(ANoteID: string; ANoteRec: TEditNoteRec): string; overload;
254function MakeXMLParamTIU(ADCSummID: string; ADCSummRec: TEditDCSummRec): string; overload;
255function GetXMLParamReturnValueTIU(DocInfo, ParamTag: string): string;
256
257const
258//EmptyNodeText = '<^Empty Node^>'; <-- original line. //kt 8/8/2007
259//NewTemplateName = 'New Template'; <-- original line. //kt 8/8/2007
260 FirstRealTemplateType = ttMyRoot;
261 LastRealTemplateType = ttGroup;
262 TemplateTypeCodes: array[FirstRealTemplateType..LastRealTemplateType] of string[2] =
263 ('P','R','TF','CF','OF','C','T','G');
264//BadNameText = CRLF + CRLF + 'Valid Template names must start with an alphanumber '+ <-- original line. //kt 8/8/2007
265// 'character, and be at least 3 characters in length.' + CRLF + <-- original line. //kt 8/8/2007
266// 'In addition, no template can be named "' + NewTemplateName+'".'; <-- original line. //kt 8/8/2007
267
268//TemplateLockedText = 'Template %s is currently being edited by another user.'; <-- original line. //kt 8/8/2007
269
270 XMLTemplateTag = 'TEMPLATE';
271 XMLTemplateFieldsTag = 'TEMPLATE_FIELDS';
272 XMLHeader = 'CPRS_TEMPLATE';
273
274function EmptyNodeText: string; //kt added to replace constant 8/17/07
275function NewTemplateName: string; //kt added to replace constant 8/17/07
276function BadNameText: string; //kt added to replace constant 8/17/07
277function TemplateLockedText: string; //kt added to replace constant 8/17/07
278
279var
280 Templates: TStringList = nil;
281 RootTemplate: TTemplate = nil;
282 MyTemplate: TTemplate = nil;
283 TitlesTemplate: TTemplate = nil;
284 ConsultsTemplate: TTemplate = nil;
285 ProceduresTemplate: TTemplate = nil;
286 bUsingHTMLMode : boolean = false; //kt 8/09
287
288implementation
289
290uses
291 Windows, rTemplates, uCore, dShared, fTemplateDialog, ActiveX, ComObj, uTemplateFields,
292 XMLUtils, fTemplateImport, Word97, uSpell, rCore, uConst, ORCtrls, uEventHooks,
293 fReminderDialog, rODBase
294 , rHTMLTools, DKLang //kt
295 ;
296
297const
298 MaxSeq = 999999;
299//sLoading = 'Loading Template Information...'; <-- original line. //kt 8/8/2007
300
301function sLoading : string;
302begin Result := DKLangConstW('uTemplates_Loading_Template_Informationxxx'); //kt added 8/8/2007
303end;
304
305type
306 ETemplateError = class(Exception);
307 ETemplateImportError = class(Exception);
308 ETemplateXMLImportError = class(EOleSysError);
309
310var
311 TemplateAccessLevelChecked: boolean = FALSE;
312 TemplateAccessLevelValue: TTemplateAccess;
313 LastTemplateLocation: integer = 0;
314 TempSL: TStringList = nil;
315 Deleted: TStringList = nil;
316 NodeCount: longint = 0; // Used by FNodes to prevent access violations in a Resync
317
318 GettingDialogText: boolean = FALSE;
319 uIndentLevel: integer;
320 uDlgCount: longint = 0; // Used for dialogs on unsaved templates
321 uUniqueIDNum: longint = 0; // Used for dialogs on unsaved templates
322 uCanEditLinkTypeResults: string = '';
323 uTemplateDataLoaded: boolean = FALSE;
324 uDGroupConsults: integer = 0;
325 uDGroupProcedures: integer = 0;
326
327type
328 TTemplateExportField = (efName, efBlankLines, efType, efStatus, efExclude, efDialog,
329 efDisplayOnly, efFirstLine, efOneItemOnly, efHideDialogItems,
330 efHideTreeItems, efIndentItems, efBoilerplate, efDescription,
331 efItems, efLock);
332
333const
334 TemplateActiveCode: array[boolean] of string[1] = ('I','A');
335 TemplateExportTag: array[TTemplateExportField] of string = // From Field Names in File 8927
336 { efName } ('NAME',
337 { efBlankLines } 'BLANK_LINES',
338 { efType } 'TYPE',
339 { efStatus } 'STATUS',
340 { efExclude } 'EXCLUDE_FROM_GROUP_BOILERPLATE',
341 { efDialog } 'DIALOG',
342 { efDisplayOnly } 'DISPLAY_ONLY',
343 { efFirstLine } 'FIRST_LINE',
344 { efOneItemOnly } 'ONE_ITEM_ONLY',
345 { efHideDialogItems } 'HIDE_DIALOG_ITEMS',
346 { efHideTreeItems } 'HIDE_TREE_ITEMS',
347 { efIndentItems } 'INDENT_ITEMS',
348 { efBoilerplate } 'BOILERPLATE_TEXT',
349 { efDescription } 'DESCRIPTION',
350 { efItems } 'ITEMS',
351 { efLock } 'LOCK');
352
353 ExportPieces:array[TTemplateExportField] of integer =
354 { efName } (4,
355 { efBlankLines } 6,
356 { efType } 2,
357 { efStatus } 3,
358 { efExclude } 5,
359 { efDialog } 9,
360 { efDisplayOnly } 10,
361 { efFirstLine } 11,
362 { efOneItemOnly } 12,
363 { efHideDialogItems } 13,
364 { efHideTreeItems } 14,
365 { efIndentItems } 15,
366 { efBoilerplate } 0,
367 { efDescription } 0,
368 { efItems } 0,
369 { efLock } 18);
370
371//XMLErrorMessage = 'Error Importing Template. File does not contain Template ' + <-- original line. //kt 8/8/2007
372// 'information or may be corrupted.'; <-- original line. //kt 8/8/2007
373//WordErrorMessage = 'Error Importing Word Document.'; <-- original line. //kt 8/8/2007
374
375function XMLErrorMessage : string;
376begin Result := DKLangConstW('uTemplates_Error_Importing_Templatex__File_does_not_contain_Template') +
377 DKLangConstW('uTemplates_information_or_may_be_corruptedx'); //kt added 8/8/2007
378end;
379
380function WordErrorMessage : string;
381begin Result := DKLangConstW('uTemplates_Error_Importing_Word_Documentx'); //kt added 8/8/2007
382end;
383
384
385type
386 TTemplateFieldExportField = (tfName, tfType, tfLength, tfDefault, tfDefIdx, tfDesc,
387 tfItems, tfDateType, tfTextLen, tfMinVal, tfMaxVal);
388
389const
390 TemplateFieldExportTag: array[TTemplateFieldExportField] of string = // From Field Names in File 8927.1
391 { tfName } ('NAME',
392 { tfType } 'TYPE',
393 { tfLength } 'LENGTH',
394 { tfDefault } 'DEFAULT_TEXT',
395 { tfDefIdx } 'DEFAULT_INDEX',
396 { tfDesc } 'DESCRIPTION',
397 { tfItems } 'ITEMS',
398 { tfDateType } 'DATE_TYPE',
399 { tfTextLen } 'MAX_LENGTH',
400 { tfMinVal } 'MIN_VALUE',
401 { tfMaxVal } 'MAX_VALUE');
402
403 XMLFieldTag = 'FIELD';
404
405 LinkGlobal: array[TTemplateLinkType] of string =
406 { ltNone } ('',
407 { ltTitle } ';TIU(8925.1,',
408 { ltConsult } ';GMR(123.5,',
409 { ltProcedure } ';GMR(123.3,');
410
411 LinkPassCode: array[TTemplateLinkType] of string =
412 { ltNone } ('',
413 { ltTitle } 'T',
414 { ltConsult } 'C',
415 { ltProcedure } 'P');
416
417//kt Added function to replace constant declarations 8/17/2007
418function EmptyNodeText: string;
419begin Result := '<^'+DKLangConstW('uTemplates_Empty_Node')+'^>';
420end;
421
422//kt Added function to replace constant declarations 8/17/2007
423function NewTemplateName: string;
424begin Result := DKLangConstW('uTemplates_New_Template');
425end;
426
427//kt Added function to replace constant declarations 8/17/2007
428function BadNameText: string;
429begin
430 Result := CRLF + CRLF +
431 DKLangConstW('uTemplates_Valid_Template_names_must_start_with_an_alphanumber')+
432 DKLangConstW('uTemplates_characterx_and_be_at_least_3_characters_in_lengthx') + CRLF +
433 DKLangConstW('uTemplates_In_additionx_no_template_can_be_named_x') + NewTemplateName+'".';
434end;
435
436//kt Added function to replace constant declarations 8/17/2007
437function TemplateLockedText: string;
438begin Result := DKLangConstW('uTemplates_Template_xs_is_currently_being_edited_by_another_userx');
439end;
440
441function DlgText(const txt: string; DlgProps: string): string;
442var
443 i, j: integer;
444
445begin
446 Result := txt;
447 if GettingDialogText then
448 begin
449 if (Result = '') then
450 Result := NoTextMarker;
451 i := pos(DlgPropMarker, Result);
452 j := pos(ObjMarker, Result);
453 if(i > 0) and (j > 0) then
454 delete(Result, i, j - i + ObjMarkerLen)
455 else
456 i := length(Result) + 1;
457 insert(DlgPropMarker + DlgProps + ObjMarker, Result, i);
458 end;
459end;
460
461function SearchMatch(const SubStr, Str: string; const WholeWordsOnly: boolean): boolean;
462const
463 AlphaNumeric = ['A'..'Z','a'..'z','0'..'9'];
464
465var
466 i, j: integer;
467
468begin
469 i := pos(SubStr,Str);
470 if(i > 0) then
471 begin
472 Result := TRUE;
473 if(WholeWordsOnly) then
474 begin
475 if((i > 1) and (Str[i-1] in AlphaNumeric)) then
476 Result := FALSE
477 else
478 begin
479 j := length(SubStr);
480 if((i+j) <= length(Str)) then
481 Result := (not (Str[i+j] in AlphaNumeric));
482 end;
483 end;
484 end
485 else
486 Result := FALSE;
487end;
488
489function UserTemplateAccessLevel: TTemplateAccess;
490var
491 i: integer;
492
493begin
494 if(TemplateAccessLevelChecked and
495 (LastTemplateLocation = Encounter.Location)) then
496 Result := TemplateAccessLevelValue
497 else
498 begin
499 TemplateAccessLevelChecked := FALSE;
500 LastTemplateLocation := 0;
501 if(not assigned(RootTemplate)) then
502 begin
503 Result := taAll;
504 GetTemplateRoots;
505 for i := 0 to RPCBrokerV.Results.Count-1 do
506 begin
507 if(Piece(RPCBrokerV.Results[i],U,2)=TemplateTypeCodes[ttRoot]) then
508 begin
509 Result := TTemplateAccess(GetTemplateAccess(Piece(RPCBrokerV.Results[i],U,1)));
510 LastTemplateLocation := Encounter.Location;
511 TemplateAccessLevelChecked := TRUE;
512 TemplateAccessLevelValue := Result;
513 Break;
514 end;
515 end;
516 end
517 else
518 begin
519 Result := TTemplateAccess(GetTemplateAccess(RootTemplate.ID));
520 LastTemplateLocation := Encounter.Location;
521 TemplateAccessLevelChecked := TRUE;
522 TemplateAccessLevelValue := Result;
523 end;
524 end;
525end;
526
527function AddTemplate(DataString: string; Owner: TTemplate = nil): TTemplate;
528var
529 idx: integer;
530 id: string;
531 tmpl: TTemplate;
532
533begin
534 id := Piece(DataString, U, 1);
535 if(id = '') or (id = '0') then
536 idx := -1
537 else
538 idx := Templates.IndexOf(id);
539 if(idx < 0) then
540 begin
541 tmpl := TTemplate.Create(DataString);
542 Templates.AddObject(id, tmpl);
543 if(tmpl.Active) then
544 begin
545 if (tmpl.RealType = ttRoot) then
546 RootTemplate := tmpl
547 else if (tmpl.RealType = ttTitles) then
548 TitlesTemplate := tmpl
549 else if (tmpl.RealType = ttConsults) then
550 ConsultsTemplate := tmpl
551 else if (tmpl.RealType = ttProcedures) then
552 ProceduresTemplate := tmpl
553 else if(tmpl.RealType = ttMyRoot) then
554 MyTemplate := tmpl;
555 end;
556 end
557 else
558 tmpl := TTemplate(Templates.Objects[idx]);
559 if(assigned(Owner)) and (assigned(tmpl)) then
560 Owner.AddChild(tmpl);
561 Result := tmpl;
562end;
563
564procedure LoadTemplateData;
565var
566 i: integer;
567 TmpSL: TStringList;
568
569begin
570 if(not uTemplateDataLoaded) then
571 begin
572 StatusText(sLoading);
573 try
574 if(not assigned(Templates)) then
575 Templates := TStringList.Create;
576 TmpSL := TStringList.Create;
577 try
578 GetTemplateRoots;
579 TmpSL.Assign(RPCBrokerV.Results);
580 for i := 0 to TmpSL.Count-1 do
581 AddTemplate(TmpSL[i]);
582 uTemplateDataLoaded := TRUE;
583 finally
584 TmpSL.Free;
585 end;
586 finally
587 StatusText('');
588 end;
589 end;
590end;
591
592procedure ExpandTemplate(tmpl: TTemplate);
593var
594 i: integer;
595 TmpSL: TStringList;
596
597begin
598 if(not tmpl.Expanded) then
599 begin
600 if(tmpl.Children <> tcNone) then
601 begin
602 StatusText(sLoading);
603 try
604 TmpSL := TStringList.Create;
605 try
606 GetTemplateChildren(tmpl.FID);
607 TmpSL.Assign(RPCBrokerV.Results);
608 for i := 0 to TmpSL.Count-1 do
609 AddTemplate(TmpSL[i], tmpl);
610 finally
611 TmpSL.Free;
612 end;
613 finally
614 StatusText('');
615 end;
616 end;
617 tmpl.Expanded := TRUE;
618 with tmpl,tmpl.FBkup do
619 begin
620 BItemIENs := ItemIENs;
621 SavedItemIENs := TRUE;
622 end;
623 end;
624end;
625
626procedure ReleaseTemplates;
627var
628 i: integer;
629
630begin
631 if(assigned(Templates)) then
632 begin
633 for i := 0 to Templates.Count-1 do
634 TTemplate(Templates.Objects[i]).Free;
635 Templates.Free;
636 Templates := nil;
637 uTemplateDataLoaded := FALSE;
638 end;
639 ClearBackup;
640 if(assigned(TempSL)) then
641 begin
642 TempSL.Free;
643 TempSL := nil;
644 end;
645 if(assigned(Deleted)) then
646 begin
647 Deleted.Clear;
648 Deleted := nil;
649 end;
650 RootTemplate := nil;
651 MyTemplate := nil;
652 TitlesTemplate := nil;
653 ConsultsTemplate := nil;
654 ProceduresTemplate := nil;
655end;
656
657procedure RemoveAllNodes;
658var
659 i: integer;
660
661begin
662 if(assigned(Templates)) then
663 begin
664 for i := 0 to Templates.Count-1 do
665 TTemplate(Templates.Objects[i]).FNodes.Clear;
666 end;
667end;
668
669function CanEditLinkType(LinkType: TTemplateLinkTypes): boolean;
670
671 function CanEditType(Template: TTemplate): boolean;
672 begin
673 if not assigned(Template) then
674 Result := FALSE
675 else
676 if pos(Char(ord(LinkType)+ord('0')), uCanEditLinkTypeResults) > 0 then
677 Result := (pos(Char(ord(LinkType)+ord('A')), uCanEditLinkTypeResults) > 0)
678 else
679 begin
680 Result := IsUserTemplateEditor(Template.ID, User.DUZ);
681 uCanEditLinkTypeResults := uCanEditLinkTypeResults + Char(ord(LinkType)+ord('0'));
682 if Result then
683 uCanEditLinkTypeResults := uCanEditLinkTypeResults + Char(ord(LinkType)+ord('A'));
684 end;
685 end;
686
687begin
688 case LinkType of
689 ttTitles: Result := CanEditType(TitlesTemplate);
690 ttConsults: Result := CanEditType(ConsultsTemplate);
691 ttProcedures: Result := CanEditType(ProceduresTemplate);
692 else Result := FALSE;
693 end;
694end;
695
696function GetLinkedTemplate(IEN: string; LType: TTemplateLinkType): TTemplate;
697var
698 idx: integer;
699 Data, ALink: string;
700
701begin
702 Result := nil;
703 if LType <> ltNone then
704 begin
705 if(not assigned(Templates)) then
706 Templates := TStringList.Create;
707 ALink := IEN + LinkGlobal[LType];
708 for idx := 0 to Templates.Count-1 do
709 begin
710 if ALink = TTemplate(Templates.Objects[idx]).FFileLink then
711 begin
712 Result := TTemplate(Templates.Objects[idx]);
713 break;
714 end;
715 end;
716 if not assigned(Result) then
717 begin
718 Data := GetLinkedTemplateData(ALink);
719 if Data <> '' then
720 Result := AddTemplate(Data);
721 end;
722 end;
723end;
724
725function ConvertFileLink(IEN: string; LType: TTemplateLinkType): string;
726begin
727 if(LType = ltNone) or (IEN = '') or (StrToIntDef(IEN,0) = 0) then
728 Result := ''
729 else
730 Result := IEN + LinkGlobal[LType];
731end;
732
733function GetLinkName(IEN: string; LType: TTemplateLinkType): string;
734var
735 IEN64: Int64;
736
737begin
738 IEN64 := StrToInt64Def(IEN,0);
739 case LType of
740 ltTitle: Result := ExternalName(IEN64,8925.1);
741 ltConsult: Result := ExternalName(IEN64,123.5);
742 ltProcedure: Result := ExternalName(IEN64,123.3);
743 else Result := '';
744 end;
745end;
746
747function BackupDiffers: boolean;
748var
749 i: integer;
750
751begin
752 Result := FALSE;
753 if(assigned(Templates)) then
754 begin
755 for i := 0 to Templates.Count-1 do
756 begin
757 if(TTemplate(Templates.Objects[i]).Changed) then
758 begin
759 Result := TRUE;
760 exit;
761 end;
762 end;
763 end;
764end;
765
766procedure DisplayErrors(Errors: TStringList; SingleError: string = '');
767begin
768 if(assigned(Errors)) then
769 ShowMessage(Errors.text)
770 else
771 ShowMessage(SingleError);
772end;
773
774
775procedure SaveTemplate(Template: TTemplate; Idx: integer; ErrorList: TStrings = nil);
776var
777 i: integer;
778 ID, Tmp: string;
779 NoCheck: boolean;
780 DescSL: TStringList;
781
782begin
783{ Removed because this may be a bug??? - what if it's hidden? -
784 better to save and delete than miss it
785//Don't save new templates that have been deleted
786 if(((Template.ID = '0') or (Template.ID = '')) and
787 (Template.Nodes.Count = 0)) then exit;
788}
789 if(not Template.Changed) then
790 begin
791 Template.Unlock;
792 exit;
793 end;
794
795 if(not assigned(TempSL)) then
796 TempSL := TStringList.Create;
797 TempSL.Clear;
798 ID := Template.ID;
799
800 NoCheck := (ID = '0') or (ID = '');
801
802 with Template,Template.FBkup do
803 begin
804 if(NoCheck or (SavedBoilerplate and (BBoilerplate <> Boilerplate))) then
805 begin
806 TempSL.Text := BoilerPlate;
807 if(TempSL.Count > 0) then
808 begin
809 for i := 0 to TempSL.Count-1 do
810 TempSL[i] := '2,'+IntToStr(i+1)+',0='+TempSL[i];
811 end
812 else
813 TempSL.Add('2,1=@');
814 end;
815
816 if(NoCheck or (SavedPrintName and (BPrintName <> PrintName))) then
817 TempSL.Add('.01='+PrintName);
818
819 if(NoCheck or (SavedGap and (BGap <> Gap))) then
820 begin
821 if Gap = 0 then
822 TempSL.Add('.02=@')
823 else
824 TempSL.Add('.02='+IntToStr(Gap));
825 end;
826
827 if(NoCheck or (SavedRealType and (BRealType <> RealType))) then
828 TempSL.Add('.03='+TemplateTypeCodes[RealType]);
829
830 if(NoCheck or (SavedActive and (BActive <> Active))) then
831 TempSL.Add('.04='+TemplateActiveCode[Active]);
832
833 if(NoCheck or (SavedExclude and (BExclude <> FExclude))) then
834 TempSL.Add('.05='+BOOLCHAR[Exclude]);
835
836 if(NoCheck or (SavedDialog and (BDialog <> FDialog))) then
837 TempSL.Add('.08='+BOOLCHAR[Dialog]);
838
839 if(NoCheck or (SavedDisplayOnly and (BDisplayOnly <> DisplayOnly))) then
840 TempSL.Add('.09='+BOOLCHAR[DisplayOnly]);
841
842 if(NoCheck or (SavedFirstLine and (BFirstLine <> FirstLine))) then
843 TempSL.Add('.1='+BOOLCHAR[FirstLine]);
844
845 if(NoCheck or (SavedOneItemOnly and (BOneItemOnly <> OneItemOnly))) then
846 TempSL.Add('.11='+BOOLCHAR[OneItemOnly]);
847
848 if(NoCheck or (SavedHideDlgItems and (BHideDlgItems <> HideDlgItems))) then
849 TempSL.Add('.12='+BOOLCHAR[HideDlgItems]);
850
851 if(NoCheck or (SavedHideItems and (BHideItems <> HideItems))) then
852 TempSL.Add('.13='+BOOLCHAR[HideItems]);
853
854 if(NoCheck or (SavedIndentItems and (BIndentItems <> IndentItems))) then
855 TempSL.Add('.14='+BOOLCHAR[IndentItems]);
856
857 if(NoCheck or (SavedReminderDialog and (BReminderDialog <> ReminderDialog))) then
858 begin
859 if ReminderDialogIEN = '' then
860 TempSL.Add('.15=@')
861 else
862 TempSL.Add('.15='+ReminderDialogIEN);
863 end;
864
865 if(NoCheck or (SavedLock and (BLock <> Lock))) then
866 TempSL.Add('.16='+BOOLCHAR[Lock]);
867
868 if(NoCheck or (SavedCOMObject and (BCOMObject <> COMObject))) then
869 begin
870 if COMObject = 0 then
871 TempSL.Add('.17=@')
872 else
873 TempSL.Add('.17='+IntToStr(COMObject));
874 end;
875
876 if(NoCheck or (SavedCOMParam and (BCOMParam <> COMParam))) then
877 begin
878 if COMParam = '' then
879 TempSL.Add('.18=@')
880 else
881 TempSL.Add('.18=' + COMParam);
882 end;
883
884 if(NoCheck or (SavedFileLink and (BFileLink <> FileLink))) then
885 begin
886 if FileLink = '' then
887 TempSL.Add('.19=@')
888 else
889 TempSL.Add('.19=' + FileLink);
890 end;
891
892 if(NoCheck or (SavedPersonalOwner and (BPersonalOwner <> PersonalOwner))) then
893 begin
894 if(PersonalOwner = 0) then
895 Tmp := ''
896 else
897 Tmp := IntToStr(PersonalOwner);
898 TempSL.Add('.06='+Tmp);
899 end;
900
901 if(NoCheck or (SavedDescription and (BDescription <> Description))) then
902 begin
903 DescSL := TStringList.Create;
904 try
905 DescSL.Text := Description;
906 if(DescSL.Count > 0) then
907 begin
908 for i := 0 to DescSL.Count-1 do
909 DescSL[i] := '5,'+IntToStr(i+1)+',0='+DescSL[i];
910 end
911 else
912 DescSL.Add('5,1=@');
913 TempSL.AddStrings(DescSL)
914 finally
915 DescSL.Free;
916 end;
917 end;
918
919 end;
920
921 if(TempSL.Count > 0) then
922 begin
923 Tmp := UpdateTemplate(ID, TempSL);
924 if(Piece(Tmp,U,1) = '0') then
925 begin
926// Tmp := 'Error Saving ' + Template.PrintName + ' ' + ID + '=' + Tmp; <-- original line. //kt 8/8/2007
927 Tmp := DKLangConstW('uTemplates_Error_Saving') + Template.PrintName + ' ' + ID + '=' + Tmp; //kt added 8/8/2007
928 if(Assigned(ErrorList)) then
929 ErrorList.Add(Tmp)
930 else
931 DisplayErrors(nil, Tmp);
932 end
933 else
934 begin
935 if(((ID = '') or (ID = '0')) and (Tmp <> ID)) then
936 begin
937 if(idx < 0) then
938 idx := Templates.IndexOfObject(Template);
939 Template.FID := Tmp;
940 Templates[idx] := Tmp;
941 if assigned(Template.FNodes) then
942 begin
943 for i := 0 to Template.FNodes.Count-1 do
944 TORTreeNode(Template.FNodes.Objects[i]).StringData := Template.ID + U + Template.PrintName;
945 end;
946 end;
947 Template.ClearBackup(FALSE);
948 if NoCheck then with Template.FBkup do
949 begin
950 BItemIENs := '';
951 SavedItemIENs := TRUE;
952 end;
953 end;
954 end;
955end;
956
957function SaveAllTemplates: boolean;
958var
959 i, k: integer;
960 New: TTemplate;
961 Errors: TStringList;
962 First, ChildErr: boolean;
963
964begin
965 Errors := TStringList.Create;
966 try
967 if(assigned(Templates)) then
968 begin
969 if(not assigned(TempSL)) then
970 TempSL := TStringList.Create;
971 for i := 0 to Templates.Count-1 do
972 SaveTemplate(TTemplate(Templates.Objects[i]), i, Errors);
973 First := TRUE;
974 if(Errors.Count > 0) then
975// Errors.Insert(0,'Errors Encountered Saving Templates:'); <-- original line. //kt 8/8/2007
976 Errors.Insert(0,DKLangConstW('uTemplates_Errors_Encountered_Saving_Templatesx')); //kt added 8/8/2007
977 for i := 0 to Templates.Count-1 do
978 begin
979 New := TTemplate(Templates.Objects[i]);
980 with New.FBkup do
981 if(SavedItemIENs and (BItemIENs <> New.ItemIENs)) then
982 begin
983 TempSL.Clear;
984 for k := 0 to New.Items.Count-1 do
985 TempSL.Add(TTemplate(New.Items[k]).FID);
986 UpdateChildren(New.ID, TempSL);
987 ChildErr := FALSE;
988 for k := 0 to RPCBrokerV.Results.Count-1 do
989 begin
990 if(RPCBrokerV.Results[k] <> IntToStr(k+1)) then
991 begin
992 if(First) then
993 begin
994// Errors.Add('Errors Encountered Saving Children:'); <-- original line. //kt 8/8/2007
995 Errors.Add(DKLangConstW('uTemplates_Errors_Encountered_Saving_Childrenx')); //kt added 8/8/2007
996 First := FALSE;
997 end;
998// Errors.Add(New.ID+' Item #'+IntToStr(k+1)+'('+ <-- original line. //kt 8/8/2007
999 Errors.Add(New.ID+DKLangConstW('uTemplates_Item_x')+IntToStr(k+1)+'('+ //kt added 8/8/2007
1000 TTemplate(New.Items[k]).FID+')'+'='+RPCBrokerV.Results[k]);
1001 ChildErr := TRUE;
1002 end;
1003 end;
1004 if(not ChildErr) then
1005 BItemIENs := New.ItemIENs;
1006 end;
1007 New.Unlock;
1008 end;
1009 if(assigned(Deleted)) and (Deleted.Count > 0) then
1010 begin
1011 DeleteTemplates(Deleted);
1012 Deleted.Clear;
1013 end;
1014 if(Errors.Count > 0) then
1015 DisplayErrors(Errors);
1016 end;
1017 finally
1018 Result := (Errors.Count = 0);
1019 Errors.Free;
1020 end;
1021end;
1022
1023procedure ClearBackup;
1024var
1025 i: integer;
1026
1027begin
1028 if(assigned(Templates)) then
1029 begin
1030 for i := 0 to Templates.Count-1 do
1031 TTemplate(Templates.Objects[i]).ClearBackup;
1032 end;
1033end;
1034
1035procedure MarkDeleted(Template: TTemplate);
1036var
1037 i, idx: integer;
1038
1039begin
1040 if(Template.ValidID) then
1041 begin
1042 if(not assigned(Deleted)) then
1043 Deleted := TStringList.Create;
1044 idx := Deleted.IndexOf(Template.ID);
1045 if(idx < 0) then
1046 Deleted.Add(Template.ID);
1047 end;
1048 Template.FileLink := '';
1049 Template.GetItems;
1050 for i := 0 to Template.FItems.Count-1 do
1051 MarkDeleted(TTemplate(Template.FItems[i]));
1052end;
1053
1054function BadTemplateName(Text: string): boolean;
1055begin
1056 Result := FALSE;
1057 if(Text = NewTemplateName) or (length(Text) < 3) then
1058 Result := TRUE
1059 else
1060 if(not (Text[1] in ['a'..'z','A'..'Z','0'..'9'])) then
1061 Result := TRUE;
1062end;
1063
1064procedure WordImportError(msg: string);
1065begin
1066 raise ETemplateImportError.Create(WordErrorMessage + CRLF + msg);
1067end;
1068
1069procedure XMLImportError(Result: HResult);
1070begin
1071 raise ETemplateXMLImportError.Create(XMLErrorMessage, Result, 0);
1072end;
1073
1074procedure XMLImportCheck(Result: HResult);
1075begin
1076 if not Succeeded(Result) then
1077 XMLImportError(Result);
1078end;
1079
1080procedure AddXMLData(Data: TStrings; const Pad: string; FldType: TTemplateExportField; const Value, DefValue: string);
1081begin
1082 if(Value <> '') and (Value <> DefValue) then
1083 Data.Add(Pad + ' <' + TemplateExportTag[FldType] + '>' + Text2XML(Value) +
1084 '</' + TemplateExportTag[FldType] + '>');
1085end;
1086
1087procedure AddXMLBool(Data: TStrings; const Pad: string; FldType: TTemplateExportField; const Value: boolean);
1088begin
1089 AddXMLData(Data, Pad, FldType, BOOLCHAR[Value], BOOLCHAR[FALSE]);
1090end;
1091
1092procedure AddXMLList(Data, Fields: TStrings; const Pad: string; FldType: TTemplateExportField; Const Txt: string);
1093var
1094 i: integer;
1095 TmpSL: TStrings;
1096
1097begin
1098 if(Txt <> '') then
1099 begin
1100 TmpSL := TStringList.Create;
1101 try
1102 TmpSL.Text := Txt;
1103 Data.Add(Pad + ' <' + TemplateExportTag[FldType] + '>');
1104 for i := 0 to TmpSL.Count-1 do
1105 Data.Add(Pad + ' <p>' + Text2XML(TmpSL[i]) + '</p>');
1106 Data.Add(Pad + ' </' + TemplateExportTag[FldType] + '>');
1107 finally
1108 TmpSL.Free;
1109 end;
1110 if assigned(Fields) then
1111 ListTemplateFields(Txt, Fields);
1112 end;
1113end;
1114
1115function GetXMLFromWord(const AFileName: string; Data: TStrings): boolean;
1116var
1117 itmp, itmp2, itmp3, i, j: integer;
1118 WDoc: TWordDocument;
1119 WasVis: boolean;
1120 WApp: TWordApplication;
1121 Boiler: string;
1122 FldCache, Fields, PendingAdd: TStringList;
1123 OldCur: TCursor;
1124 idx, TmpVar, RangeStart, RangeEnd: oleVariant;
1125 ddTotal, ffTotal, ffStartCur, ffEndCur, ffEndLast : integer;
1126 ffRange, textRange: Range;
1127 tmp, TemplateName, fName: string;
1128 tmpType, tfIdx: TTemplateFieldType;
1129 tmpDate: TTmplFldDateType;
1130
1131 tfCount: array[TTemplateFieldType] of integer;
1132
1133 procedure AddBoiler(txt: string);
1134 var
1135 i: integer;
1136 c: char;
1137 tmp: string;
1138
1139 begin
1140 tmp := '';
1141 for i := 1 to length(txt) do
1142 begin
1143 c := txt[i];
1144 if (c > #31) or (c = #13) or (c = #10) then
1145 tmp := tmp + c;
1146 end;
1147 Boiler := Boiler + tmp;
1148 end;
1149
1150 procedure AddField(Typ: TTemplateFieldExportField; Value: string; Pending: boolean = FALSE);
1151 var
1152 sl: TStringList;
1153
1154 begin
1155 if Pending then
1156 sl := PendingAdd
1157 else
1158 sl := Fields;
1159 sl.Add('<' + TemplateFieldExportTag[Typ] + '>' + Text2XML(Value) +
1160 '</' + TemplateFieldExportTag[Typ] + '>');
1161 end;
1162
1163 procedure AddFieldHeader(FldType: TTemplateFieldType; First: boolean);
1164 var
1165 tmp: string;
1166
1167 begin
1168 tmp := '<';
1169 if not First then
1170 tmp := tmp + '/';
1171 tmp := tmp + XMLFieldTag;
1172 if First then
1173 begin
1174 fname := 'WORDFLD_' + FldNames[FldType] + '_';
1175 tfIdx := FldType;
1176 tmp := tmp + ' ' + TemplateFieldExportTag[tfName] + '="' + Text2XML(fname);
1177 end;
1178 if not First then
1179 tmp := tmp + '>';
1180 Fields.Add(tmp);
1181 if First then
1182 AddField(tfType, TemplateFieldTypeCodes[FldType]);
1183 end;
1184
1185 procedure WordWrap(var Str: string);
1186 var
1187 TmpSL: TStringList;
1188 i: integer;
1189
1190 begin
1191 TmpSL := TStringList.Create;
1192 try
1193 TmpSL.Text := Str;
1194 Str := '';
1195 for i := 0 to TmpSL.Count-1 do
1196 begin
1197 if Str <> '' then
1198 Str := Str + CRLF;
1199 Str := Str + WrapText(TmpSL[i], #13#10, [' ','-'], MAX_ENTRY_WIDTH);
1200 end;
1201 finally
1202 TmpSL.Free;
1203 end;
1204 end;
1205
1206begin
1207 for tfIdx := low(TTemplateFieldType) to high(TTemplateFieldType) do
1208 tfCount[tfIdx] := 1;
1209 TemplateName := ExtractFileName(AFileName);
1210 Result := TRUE;
1211 try
1212 OldCur := Screen.Cursor;
1213 Screen.Cursor := crAppStart;
1214 try
1215 WApp := TWordApplication.Create(nil);
1216 try
1217 WasVis := WApp.Visible;
1218 WApp.Visible := FALSE;
1219 try
1220 WDoc := TWordDocument.Create(nil);
1221 try
1222 try
1223 WApp.Connect;
1224 TmpVar := AFileName;
1225 WDoc.ConnectTo(WApp.Documents.Add(TmpVar, EmptyParam));
1226 ffTotal := WDoc.FormFields.Count;
1227
1228 if ffTotal > 3 then
1229 StartImportMessage(TemplateName, ffTotal+1);
1230
1231 if WDoc.ProtectionType <> wdNoProtection then
1232 WDoc.Unprotect;
1233
1234 Data.Add('<'+XMLHeader+'>');
1235
1236 tmp := ExtractFileExt(TemplateName);
1237 if tmp <> '' then
1238 begin
1239 i := pos(tmp,TemplateName);
1240 if i > 0 then
1241 delete(TemplateName, i, length(tmp));
1242 end;
1243 TemplateName := copy(TemplateName, 1, 60);
1244
1245 if BadTemplateName(TemplateName) then
1246 begin
1247// tmp := copy('WordDoc ' + TemplateName, 1, 60); <-- original line. //kt 8/8/2007
1248 tmp := copy(DKLangConstW('uTemplates_WordDoc') + TemplateName, 1, 60); //kt added 8/8/2007
1249 if BadTemplateName(TemplateName) then
1250// tmp := 'Imported Word Document' <-- original line. //kt 8/8/2007
1251 tmp := DKLangConstW('uTemplates_Imported_Word_Document') //kt added 8/8/2007
1252 else
1253 tmp := TemplateName;
1254 end
1255 else
1256 tmp := TemplateName;
1257 Data.Add('<' + XMLTemplateTag + ' ' + TemplateExportTag[efName] + '="' + Text2XML(tmp) + '">');
1258 AddXMLData(Data, '', efType, TemplateTypeCodes[ttDoc], '');
1259 AddXMLData(Data, '', efStatus, TemplateActiveCode[TRUE], '');
1260
1261 Boiler := '';
1262 Fields := TStringList.Create;
1263 try
1264 FldCache := TStringList.Create;
1265 try
1266 PendingAdd := TStringList.Create;
1267 try
1268 ffEndCur := 0;
1269
1270 for i := 1 to ffTotal do
1271 begin
1272 if UpdateImportMessage(i) then
1273 begin
1274 Result := FALSE;
1275 Data.Clear;
1276 break;
1277 end;
1278 idx := i;
1279 ffEndLast := ffEndCur;
1280 ffRange := WDoc.FormFields.Item(idx).Range;
1281 ffStartCur := ffRange.Start;
1282 ffEndCur := ffRange.End_;
1283
1284 // Assign working start range for text collection:
1285 if i = 1 then
1286 rangeStart := 0 // Before first FormField, use start of document.
1287 else
1288 rangeStart := ffEndLast; // Start of new range is end of the last FormField range.
1289
1290 // Assign working end range for text collection:
1291 rangeEnd := ffStartCur; // End of new range is start of current FormField range.
1292
1293 // Collect text in the range:
1294 textRange := WDoc.Range(rangeStart, rangeEnd);
1295 textRange.Select;
1296
1297 AddBoiler(TextRange.text);
1298 tfIdx := dftUnknown;
1299 fname := '';
1300 case WDoc.FormFields.Item(idx).type_ of
1301 wdFieldFormTextInput:
1302 begin
1303 itmp3 := WDoc.FormFields.Item(idx).TextInput.Type_;
1304 case itmp3 of
1305 wdNumberText: tmpType := dftNumber;
1306 wdDateText, wdCurrentDateText, wdCurrentTimeText: tmpType := dftDate;
1307 else tmpType := dftEditBox;
1308 end;
1309 AddFieldHeader(tmpType, TRUE);
1310 tmpDate := dtUnknown;
1311 tmp := WDoc.FormFields.Item(idx).TextInput.Default;
1312 case itmp3 of
1313 wdNumberText:
1314 begin
1315 AddField(tfMinVal, IntToStr(-9999), TRUE);
1316 AddField(tfMaxVal, IntToStr(9999), TRUE);
1317 end;
1318
1319 wdDateText: tmpDate := dtDate;
1320 wdCurrentDateText:
1321 begin
1322 tmpDate := dtDate;
1323 if tmp = '' then
1324 tmp := 'T';
1325 end;
1326 wdCurrentTimeText:
1327 begin
1328 tmpDate := dtDateTime;
1329 if tmp = '' then
1330 tmp := 'NOW';
1331 end;
1332 else
1333 begin
1334 itmp2 := WDoc.FormFields.Item(idx).TextInput.Width;
1335 itmp := itmp2;
1336 if (itmp < 1) then
1337 begin
1338 itmp := length(tmp);
1339 if itmp < 10 then
1340 itmp := 10
1341 else
1342 if itmp > 70 then
1343 itmp := 70;
1344 itmp2 := 240;
1345 end
1346 else
1347 begin
1348 if (itmp > 70) then
1349 itmp := 70;
1350 if (itmp2 > 240) then
1351 itmp2 := 240;
1352 end;
1353 AddField(tfLength, IntToStr(itmp));
1354 AddField(tfTextLen, IntToStr(itmp2), TRUE);
1355 end;
1356 end;
1357 if tmpDate <> dtUnknown then
1358 AddField(tfDateType, TemplateFieldDateCodes[tmpDate], TRUE);
1359 if tmp <> '' then
1360 AddField(tfDefault, tmp);
1361 Fields.AddStrings(PendingAdd);
1362 PendingAdd.Clear;
1363 AddFieldHeader(tmpType, FALSE);
1364 end;
1365
1366 wdFieldFormCheckBox:
1367 begin
1368 AddFieldHeader(dftButton, TRUE);
1369 itmp := ord(boolean(WDoc.FormFields.Item(idx).CheckBox.Default))+1;
1370 AddField(tfDefIdx, IntToStr(itmp));
1371 Fields.Add('<' + TemplateFieldExportTag[tfItems] + '>');
1372 Fields.Add('<p>' + Text2XML('[ ]') + '</p>');
1373 Fields.Add('<p>' + Text2XML('[X]') + '</p>');
1374 Fields.Add('</' + TemplateFieldExportTag[tfItems] + '>');
1375 AddFieldHeader(dftButton, FALSE);
1376 end;
1377
1378 wdFieldFormDropDown:
1379 begin
1380 ddTotal := WDoc.FormFields.Item(Idx).DropDown.ListEntries.Count;
1381 if(ddTotal > 0)then
1382 begin
1383 AddFieldHeader(dftComboBox, TRUE);
1384 itmp := WDoc.FormFields.Item(idx).DropDown.Default;
1385 if itmp > 0 then
1386 AddField(tfDefIdx, IntToStr(itmp));
1387
1388 Fields.Add('<' + TemplateFieldExportTag[tfItems] + '>');
1389 for j := 1 to ddTotal do
1390 begin
1391 TmpVar := j;
1392 tmp := WDoc.FormFields.Item(Idx).DropDown.ListEntries.Item(TmpVar).Name;
1393 Fields.Add('<p>' + Text2XML(tmp) + '</p>');
1394 end;
1395 Fields.Add('</' + TemplateFieldExportTag[tfItems] + '>');
1396 AddFieldHeader(dftComboBox, FALSE);
1397 end;
1398 end;
1399 end;
1400 if (Fields.Count > 0) then
1401 begin
1402 if tfIdx <> dftUnknown then
1403 begin
1404 tmp := Fields.CommaText;
1405 j := FldCache.IndexOf(tmp);
1406 if j < 0 then
1407 begin
1408 FldCache.AddObject(tmp, TObject(tfCount[tfIdx]));
1409 j := tfCount[tfIdx];
1410 inc(tfCount[tfIdx]);
1411 end
1412 else
1413 j := Integer(FldCache.Objects[j]);
1414 Boiler := Boiler + TemplateFieldBeginSignature + fname + IntToStr(j) + TemplateFieldEndSignature;
1415 end;
1416 Fields.Clear;
1417 end;
1418 end;
1419 if Result then
1420 begin
1421 rangeStart := ffEndCur; // Start of new range is end of last FormField range.
1422 rangeEnd := WDoc.Range.End_; // After last FormField, use end of document.
1423
1424 // Collect text in trailing range:
1425 textRange := WDoc.Range(rangeStart, rangeEnd);
1426 textRange.Select;
1427
1428 AddBoiler(TextRange.text);
1429
1430 WordWrap(Boiler);
1431
1432 AddXMLList(Data, nil, '', efBoilerplate, Boiler);
1433
1434// tmp := WrapText('Imported on ' + FormatFMDateTime('mmm dd yyyy hh:nn', FMNow) + <-- original line. //kt 8/8/2007
1435 tmp := WrapText(DKLangConstW('uTemplates_Imported_on')+' ' + FormatFMDateTime(DKLangConstW('uTemplates_mmm_dd_yyyy_hhxnn'), FMNow) + //kt added 8/8/2007
1436// ' from Word Document: ' + AFileName, #13#10, [' '], MAX_ENTRY_WIDTH); <-- original line. //kt 8/8/2007
1437 DKLangConstW('uTemplates_from_Word_Documentx') + AFileName, #13#10, [' '], MAX_ENTRY_WIDTH); //kt added 8/8/2007
1438
1439 AddXMLList(Data, nil, '', efDescription, tmp);
1440
1441 Data.Add('</' + XMLTemplateTag + '>');
1442 if FldCache.Count > 0 then
1443 begin
1444 Data.Add('<' + XMLTemplateFieldsTag + '>');
1445 for i := 0 to FldCache.Count-1 do
1446 begin
1447 Fields.Clear;
1448 Fields.CommaText := FldCache[i];
1449 if Fields.Count > 0 then
1450 begin
1451 Fields[0] := Fields[0] + IntToStr(Integer(FldCache.Objects[i])) + '">';
1452 Data.AddStrings(Fields);
1453 end;
1454 end;
1455 Data.Add('</' + XMLTemplateFieldsTag + '>');
1456 end;
1457
1458 Data.Add('</'+XMLHeader+'>');
1459 UpdateImportMessage(ffTotal+1);
1460 end;
1461 finally
1462 PendingAdd.Free;
1463 end;
1464 finally
1465 FldCache.Free;
1466 end;
1467 finally
1468 Fields.Free;
1469 end;
1470
1471 except
1472 on E:Exception do
1473 WordImportError(E.Message);
1474 end;
1475 finally
1476 TmpVar := wdDoNotSaveChanges;
1477 WDoc.Close(TmpVar);
1478 WDoc.Free;
1479 end;
1480 finally
1481 WApp.Visible := WasVis;
1482 end;
1483 finally
1484 WApp.Disconnect;
1485 WApp.Free;
1486 end;
1487 finally
1488 Screen.Cursor := OldCur;
1489 end;
1490 finally
1491 StopImportMessage;
1492 end;
1493 if not Result then
1494// InfoBox('Importing Word Document Canceled.','Import Canceled', MB_OK); <-- original line. //kt 8/8/2007
1495 InfoBox(DKLangConstW('uTemplates_Importing_Word_Document_Canceledx'),DKLangConstW('uTemplates_Import_Canceled'), MB_OK); //kt added 8/8/2007
1496end;
1497
1498function WordImportActive: boolean;
1499begin
1500 Result := True;
1501 //Result := SpellCheckAvailable; spell check disabled in v19.16
1502end;
1503
1504procedure UnlockAllTemplates;
1505var
1506 i: integer;
1507
1508begin
1509 if(assigned(Templates)) then
1510 begin
1511 for i := 0 to Templates.Count-1 do
1512 TTemplate(Templates.Objects[i]).Unlock;
1513 end;
1514end;
1515
1516function DisplayGroupToLinkType(DGroup: integer): TTemplateLinkType;
1517begin
1518 Result := ltNone;
1519 if DGroup <> 0 then
1520 begin
1521 if uDGroupConsults = 0 then
1522 uDGroupConsults := DisplayGroupByName('CONSULTS');
1523 if uDGroupProcedures = 0 then
1524 uDGroupProcedures := DisplayGroupByName('PROCEDURES');
1525 if DGroup = uDGroupConsults then
1526 Result := ltConsult
1527 else
1528 if DGroup = uDGroupProcedures then
1529 Result := ltProcedure;
1530 end;
1531end;
1532
1533(*procedure ExecuteTemplateOrBoilerPlate(SL: TStrings; IEN: Integer; LType: TTemplateLinkType;
1534 OwningForm: TForm; const CaptionText: string = ''; DocInfo: string = '');*)
1535procedure ExecuteTemplateOrBoilerPlate(SL: TStrings; IEN: Integer; LType: TTemplateLinkType;
1536 OwningForm: TForm; CaptionText: string; var DocInfo: string);
1537
1538var
1539 Template: TTemplate;
1540 txt: string;
1541
1542begin
1543 Template := GetLinkedTemplate(IntToStr(IEN), LType);
1544 if assigned(Template) then
1545 begin
1546 if Template.IsReminderDialog then
1547 begin
1548 Template.ExecuteReminderDialog(OwningForm);
1549 DocInfo := '';
1550 end
1551 else
1552 begin
1553 if Template.IsCOMObject then
1554 txt := Template.COMObjectText(SL.Text, DocInfo)
1555 else
1556 begin
1557 txt := Template.Text;
1558 DocInfo := '';
1559 end;
1560 if(txt <> '') then
1561 begin
1562 CheckBoilerplate4Fields(txt, CaptionText);
1563 SL.Text := txt;
1564 end;
1565 end;
1566 end
1567 else
1568 begin
1569 txt := SL.Text;
1570 CheckBoilerplate4Fields(txt, CaptionText);
1571 DocInfo := '';
1572 SL.Text := txt;
1573 end;
1574end;
1575
1576(*procedure ExecuteTemplateOrBoilerPlate(var AText: string; IEN: Integer; LType: TTemplateLinkType;
1577 OwningForm: TForm; const CaptionText: string = ''; DocInfo: string = '');*)
1578procedure ExecuteTemplateOrBoilerPlate(var AText: string; IEN: Integer; LType: TTemplateLinkType;
1579 OwningForm: TForm; CaptionText: string; var DocInfo: string);
1580
1581var
1582 tmp: TStringList;
1583
1584begin
1585 tmp := TStringList.Create;
1586 try
1587 tmp.text := AText;
1588 ExecuteTemplateOrBoilerPlate(tmp, IEN, LType, OwningForm, CaptionText, DocInfo);
1589 AText := tmp.text;
1590 finally
1591 tmp.free;
1592 end;
1593end;
1594
1595{ TTemplate }
1596
1597constructor TTemplate.Create(DataString: string);
1598var
1599 i: TTemplateType;
1600 Code: string[2];
1601
1602begin
1603 FCloning := TRUE;
1604 try
1605 FNodes := TStringList.Create;
1606 FID := Piece(DataString, U, 1);
1607 Code := Piece(DataString, U, 2);
1608 FRealType := ttNone;
1609 for i := FirstRealTemplateType to LastRealTemplateType do
1610 begin
1611 if(TemplateTypeCodes[i] = Code) then
1612 begin
1613 FRealType := i;
1614 break;
1615 end;
1616 end;
1617 if FRealType = ttNone then
1618// raise ETemplateError.Create('Template has invalid Type Code of "' + Code + '"'); <-- original line. //kt 8/8/2007
1619 raise ETemplateError.Create(DKLangConstW('uTemplates_Template_has_invalid_Type_Code_of_x') + Code + '"'); //kt added 8/8/2007
1620 FActive := (Piece(DataString, U, 3) = TemplateActiveCode[TRUE]);
1621 FPrintName := Piece(DataString, U, 4);
1622 FExclude := (Piece(DataString, U, 5) = '1');
1623 FDialog := (Piece(DataString, U, 9) = '1');
1624 FDisplayOnly := (Piece(DataString, U, 10) = '1');
1625 FFirstLine := (Piece(DataString, U, 11) = '1');
1626 FOneItemOnly := (Piece(DataString, U, 12) = '1');
1627 FHideDlgItems := (Piece(DataString, U, 13) = '1');
1628 FHideItems := (Piece(DataString, U, 14) = '1');
1629 FIndentItems := (Piece(DataString, U, 15) = '1');
1630 FLock := (Piece(DataString, U, 18) = '1');
1631 FReminderDialog := Pieces(DataString, U, 16, 17);
1632 FReminderDialog := FReminderDialog + U + Piece(DataString, U, 25); //AGP CHANGE 24.8
1633 FIsReminderDialog := (ReminderDialogIEN <> '');
1634 FCOMObject := StrToIntDef(Piece(DataString, U, 19), 0);
1635 FCOMParam := Piece(DataString, U, 20);
1636 FFileLink := Piece(DataString, U, 21);
1637 FIsCOMObject := (FCOMObject > 0);
1638 FGap := StrToIntDef(Piece(DataString, U, 6),0);
1639 FPersonalOwner := StrToInt64Def(Piece(DataString, U, 7),0);
1640 case StrToIntDef(Piece(DataString, U, 8),0) of
1641 1: FChildren := tcActive;
1642 2: FChildren := tcInactive;
1643 3: FChildren := tcBoth;
1644 else FChildren := tcNone;
1645 end;
1646 FLocked := FALSE;
1647 finally
1648 FCloning := FALSE;
1649 end;
1650end;
1651
1652class function TTemplate.CreateFromXML(Element: IXMLDOMNode; Owner: string): TTemplate;
1653var
1654 DataStr: string;
1655 Children, Items: IXMLDOMNodeList;
1656 Child, Item: IXMLDOMNode;
1657 i, j, count, ItemCount: integer;
1658 fld: TTemplateExportField;
1659 ETag: string;
1660
1661begin
1662 DataStr := '0';
1663 SetPiece(DataStr, U, 4, FindXMLAttributeValue(Element, TemplateExportTag[efName]));
1664 SetPiece(DataStr, U, 7, Owner);
1665 Children := Element.Get_childNodes;
1666 try
1667 if assigned(Children) then
1668 begin
1669 count := Children.Length;
1670 for i := 0 to Count - 1 do
1671 begin
1672 Child := Children.Item[i];
1673 ETag := Child.NodeName;
1674 for fld := low(TTemplateExportField) to high(TTemplateExportField) do
1675 begin
1676 if(ExportPieces[fld] > 0) and (CompareText(ETag, TemplateExportTag[fld]) = 0) then
1677 SetPiece(DataStr, U, ExportPieces[fld], Child.Get_Text);
1678 end;
1679 end;
1680 end
1681 else
1682 Count := 0;
1683 Result := Create(DataStr);
1684 Result.FCloning := TRUE;
1685 try
1686 if assigned(Children) then
1687 begin
1688 for i := 0 to Count - 1 do
1689 begin
1690 Child := Children.Item[i];
1691 ETag := Child.NodeName;
1692 for fld := low(TTemplateExportField) to high(TTemplateExportField) do
1693 begin
1694 if(ExportPieces[fld] = 0) and (CompareText(ETag, TemplateExportTag[fld]) = 0) then
1695 begin
1696 case fld of
1697 efBoilerplate: Result.SetBoilerplate(GetXMLWPText(Child));
1698 efDescription: Result.SetDescription(GetXMLWPText(Child));
1699 efItems:
1700 begin
1701 Result.GetItems;
1702 Items := Child.Get_childNodes;
1703 if assigned(Items) then
1704 begin
1705 ItemCount := Items.Length;
1706 for j := 0 to ItemCount - 1 do
1707 begin
1708 Item := Items.Item[j];
1709 if(CompareText(Item.NodeName, XMLTemplateTag) = 0) then
1710 Result.FItems.Add(CreateFromXML(Item, Owner));
1711 end;
1712 end;
1713 end;
1714 end;
1715 end;
1716 end;
1717 end;
1718 end;
1719 finally
1720 Result.FCloning := FALSE;
1721 end;
1722 finally
1723 Children := nil;
1724 end;
1725 Result.BackupItems;
1726 Templates.AddObject(Result.ID, Result);
1727end;
1728
1729destructor TTemplate.Destroy;
1730begin
1731 Unlock;
1732 FNodes.Free;
1733 if(assigned(FItems)) then FItems.Free;
1734 inherited;
1735end;
1736
1737procedure TTemplate.AddChild(Child: TTemplate);
1738begin
1739 GetItems;
1740 if(FItems.IndexOf(Child) < 0) then
1741 FItems.Add(Child);
1742end;
1743
1744procedure TTemplate.RemoveChild(Child: TTemplate);
1745var
1746 idx: integer;
1747
1748begin
1749 GetItems;
1750 idx := FItems.IndexOf(Child);
1751 if(idx >= 0) and CanModify then
1752 FItems.delete(idx);
1753end;
1754
1755function TTemplate.GetItems: TList;
1756begin
1757 if(not assigned(FItems)) then
1758 begin
1759 FItems := TList.Create;
1760 FCreatingChildren := TRUE;
1761 try
1762 ExpandTemplate(Self);
1763 finally
1764 FCreatingChildren := FALSE;
1765 end;
1766 end;
1767 Result := FItems;
1768end;
1769
1770function TTemplate.GetTemplateType: TTemplateType;
1771begin
1772 Result := FRealType;
1773 if(Result in [ttDoc, ttGroup]) and (FExclude) then
1774 begin
1775 case (Result) of
1776 ttDoc: Result := ttDocEx;
1777 ttGroup: Result := ttGroupEx;
1778 end;
1779 end;
1780end;
1781
1782function TTemplate.GetChildren: TTemplateChildren;
1783var
1784 i: integer;
1785
1786begin
1787 if((assigned(FItems)) and (not FCreatingChildren)) then
1788 begin
1789 Result := tcNone;
1790 for i := 0 to FItems.Count-1 do
1791 begin
1792 if(TTemplate(FItems[i]).Active) then
1793 Result := TTemplateChildren(ord(Result) or ord(tcActive))
1794 else
1795 Result := TTemplateChildren(ord(Result) or ord(tcInactive));
1796 if(Result = tcBoth) then break;
1797 end;
1798 end
1799 else
1800 Result := FChildren;
1801end;
1802
1803procedure TTemplate.SetTemplateType(const Value: TTemplateType);
1804begin
1805 if(GetTemplateType <> Value) and CanModify then
1806 begin
1807 if(Value in AllTemplateTrueTypes) then
1808 SetRealType(Value)
1809 else
1810 begin
1811 case Value of
1812 ttDoc: begin SetExclude(FALSE); SetRealType(ttDoc); end;
1813 ttGroup: begin SetExclude(FALSE); SetRealType(ttGroup); end;
1814 ttDocEx: begin SetExclude(TRUE); SetRealType(ttDoc); end;
1815 ttGroupEx: begin SetExclude(TRUE); SetRealType(ttGroup); end;
1816 end;
1817 end;
1818 end;
1819end;
1820
1821function TTemplate.GetBoilerplate: string;
1822begin
1823 Result := '';
1824 if FIsReminderDialog or FIsCOMObject then exit;
1825 if(RealType in [ttDoc, ttGroup]) then
1826 begin
1827 if(not FBoilerPlateLoaded) then
1828 begin
1829// StatusText('Loading Template Boilerplate...'); <-- original line. //kt 8/8/2007
1830 StatusText(DKLangConstW('uTemplates_Loading_Template_Boilerplatexxx')); //kt added 8/8/2007
1831 try
1832 GetTemplateBoilerplate(FID);
1833 FBoilerplate := RPCBrokerV.Results.Text;
1834 FBoilerPlateLoaded := TRUE;
1835 finally
1836 StatusText('');
1837 end;
1838 end;
1839 Result := FBoilerplate;
1840 end;
1841end;
1842
1843{ Returns the cumulative boilerplate of a groups items }
1844function TTemplate.ItemBoilerplate: string;
1845var
1846 i, j: integer;
1847 Template: TTemplate;
1848 GapStr: string;
1849
1850begin
1851 Result := '';
1852 if FIsReminderDialog or FIsCOMObject then exit;
1853 if(RealType = ttGroup) then
1854 begin
1855 GetItems;
1856 GapStr := '';
1857 if(FGap > 0) then
1858 begin
1859 for j := 1 to FGap do
1860 GapStr := GapStr + CRLF;
1861 end;
1862 if(IndentItems) then
1863 inc(uIndentLevel);
1864 try
1865 for i := 0 to FItems.Count-1 do
1866 begin
1867 Template := TTemplate(FItems[i]);
1868 if(Template.Active and (Template.TemplateType in [ttDoc, ttGroup])) then
1869 begin
1870 if i > 0 then
1871 Result := Result + GapStr;
1872 Result := Result + DlgText(TTemplate(FItems[i]).FullBoilerplate,
1873 TTemplate(FItems[i]).DialogProperties(Self));
1874 end;
1875 end;
1876 finally
1877 if(IndentItems) then
1878 dec(uIndentLevel);
1879 end;
1880 end;
1881end;
1882
1883{returns the complete boilerplate, including a group's items }
1884function TTemplate.FullBoilerplate: string;
1885var
1886 Itm: string;
1887begin
1888 Result := GetBoilerplate; //ELH
1889 if FIsReminderDialog or FIsCOMObject then exit;
1890 Itm := ItemBoilerplate;
1891 if(Result <> '') and (Itm <> '') and (copy(Result,length(Result)-1,2) <> CRLF) then
1892 Result := Result + CRLF;
1893 Result := DlgText(Result, DialogProperties) + Itm;
1894end;
1895
1896{Sets the items boilerplate - does not affect children boilerplates of a group }
1897procedure TTemplate.SetBoilerplate(Value: string);
1898begin
1899 if(FBoilerplate <> Value) and CanModify then
1900 begin
1901 with FBkup do
1902 begin
1903 if(FBoilerPlateLoaded and (not SavedBoilerplate) and ValidID) then
1904 begin
1905 BBoilerplate := FBoilerplate;
1906 SavedBoilerplate := TRUE;
1907 end;
1908 end;
1909 FBoilerplate := Value;
1910 end;
1911 FBoilerPlateLoaded := TRUE;
1912end;
1913
1914{Gets the object-expanded boilerplated text}
1915function TTemplate.GetText: string;
1916var
1917 OldGettingDialogText: boolean;
1918 TmpSL: TStringList;
1919
1920begin
1921 Result := '';
1922 if FIsReminderDialog or FIsCOMObject then exit;
1923 TmpSL := TStringList.Create;
1924 try
1925// StatusText('Expanding Boilerplate Text...'); <-- original line. //kt 8/8/2007
1926 StatusText(DKLangConstW('uTemplates_Expanding_Boilerplate_Textxxx')); //kt added 8/8/2007
1927 try
1928 OldGettingDialogText := GettingDialogText;
1929 if(IsDialog) then
1930 begin
1931 GettingDialogText := TRUE;
1932 inc(uDlgCount);
1933 if not OldGettingDialogText then
1934 uIndentLevel := 0;
1935 end;
1936 try
1937 TmpSL.Text := FullBoilerPlate;
1938 finally
1939 if(IsDialog) then
1940 GettingDialogText := OldGettingDialogText;
1941 end;
1942 GetTemplateText(TmpSL);
1943 if(IsDialog) then
1944// FDialogAborted := DoTemplateDialog(TmpSL, 'Template: ' + FPrintName, TemplatePreviewMode); <-- original line. //kt 8/8/2007
1945 FDialogAborted := DoTemplateDialog(TmpSL, DKLangConstW('uTemplates_Templatex') + FPrintName, TemplatePreviewMode); //kt added 8/8/2007
1946 if bUsingHTMLMode then begin //kt 8/09
1947 if rHTMLTools.IsHTML(TmpSL.Text) then begin //kt 8/09
1948 TmpSL.Text := rHTMLTools.FixHTMLCRLF(TmpSL.Text); //kt 8/09
1949 TmpSL.Text := rHTMLTools.ProtectHTMLSpaces(TmpSL.Text); //kt 8/09
1950 TmpSL.Text := rHTMLTools.UnwrapHTML(TmpSL.Text); //kt 8/09
1951 end else begin //kt 8/09
1952 TmpSL.Text := rHTMLTools.Text2HTML(TmpSL); //kt 8/09
1953 end; //kt 8/09
1954 //kt 12/28/09 bUsingHTMLMode := false; //force reset each call. //kt 8/09
1955 end; //kt 8/09
1956 Result := TmpSL.Text;
1957 finally
1958 StatusText('');
1959 end;
1960 finally
1961 TmpSL.Free;
1962 end;
1963end;
1964
1965procedure TTemplate.SetPersonalOwner(Value: Int64);
1966var
1967 i: integer;
1968 ok: boolean;
1969
1970begin
1971 if(FPersonalOwner <> Value) then
1972 begin
1973 ok := CanModify;
1974 if ok then
1975 begin
1976 with FBkup do
1977 begin
1978 if(not SavedPersonalOwner) and ValidID then
1979 begin
1980 BPersonalOwner := FPersonalOwner;
1981 SavedPersonalOwner := TRUE;
1982 end;
1983 end;
1984 FPersonalOwner := Value;
1985 end;
1986 end
1987 else
1988 ok := TRUE;
1989 if ok and (Value = 0) then // No Shared Template can have personal items within it.
1990 begin
1991 GetItems;
1992 for i := 0 to FItems.Count-1 do
1993 TTemplate(FItems[i]).SetPersonalOwner(0);
1994 end;
1995end;
1996
1997procedure TTemplate.AddNode(Node: Pointer);
1998begin
1999 if(dmodShared.InEditor) and (FNodes.IndexOfObject(Node) < 0) then
2000 begin
2001 inc(NodeCount);
2002 FNodes.AddObject(IntToStr(NodeCount),Node);
2003 end;
2004end;
2005
2006procedure TTemplate.RemoveNode(Node: Pointer);
2007var
2008 idx: integer;
2009
2010begin
2011 if(dmodShared.InEditor) then
2012 begin
2013 idx := FNodes.IndexOfObject(Node);
2014 if(idx >= 0) then FNodes.Delete(idx);
2015 end;
2016end;
2017
2018{ Creates a new Template that looks like the old one, but with a new Owner }
2019{ - an example of where this is needed: when a shared template in a user's }
2020{ personal folder is modified, we need to create a copy of the shared }
2021{ template, make it a personal template, and make the changes to the copy }
2022function TTemplate.Clone(Owner: Int64): TTemplate;
2023var
2024 i: integer;
2025
2026begin
2027 Result := Self;
2028 if(FPersonalOwner <> Owner) and (RealType in [ttDoc, ttGroup, ttClass]) then
2029 begin
2030 Result := TrueClone;
2031 Result.FCloning := TRUE;
2032 try
2033 Result.FID := '0';
2034 GetItems;
2035 Result.FPersonalOwner := Owner;
2036 Result.Expanded := TRUE;
2037 Result.GetItems;
2038 for i := 0 to Items.Count-1 do
2039 Result.Items.Add(Items[i]);
2040 Result.BackupItems;
2041 Templates.AddObject(Result.ID, Result);
2042 finally
2043 Result.FCloning := FALSE;
2044 end;
2045 end;
2046end;
2047
2048{ Creates a duplicate Template - used for backups and comparrisons }
2049function TTemplate.TrueClone: TTemplate;
2050var
2051 Code, DataStr: string;
2052
2053begin
2054 DataStr := ID+U+TemplateTypeCodes[RealType]+U+TemplateActiveCode[Active]+U+PrintName+U;
2055 if(Exclude) then
2056 DataStr := DataStr + '1'
2057 else
2058 DataStr := DataStr + '0';
2059 case GetChildren of
2060 tcActive: Code := '1';
2061 tcInactive: Code := '2';
2062 tcBoth: Code := '3';
2063 else Code := '0';
2064 end;
2065 DataStr := DataStr + U + IntToStr(Gap) + U + IntToStr(PersonalOwner) + U + Code + U +
2066 BOOLCHAR[Dialog] + U +
2067 BOOLCHAR[DisplayOnly] + U +
2068 BOOLCHAR[FirstLine] + U +
2069 BOOLCHAR[OneItemOnly] + U +
2070 BOOLCHAR[HideDlgItems] + U +
2071 BOOLCHAR[HideItems] + U +
2072 BOOLCHAR[IndentItems] + U +
2073 FReminderDialog;
2074 SetPiece(DataStr,U,18,BOOLCHAR[Lock]);
2075 SetPiece(DataStr,U,19,IntToStr(COMObject));
2076 SetPiece(DataStr,U,20,COMParam);
2077 SetPiece(DataStr,U,21,FileLink);
2078 Result := TTemplate.Create(DataStr);
2079 Result.FCloning := TRUE;
2080 try
2081 Result.SetBoilerplate(GetBoilerplate);
2082 Result.SetDescription(GetDescription);
2083 finally
2084 Result.FCloning := FALSE;
2085 end;
2086end;
2087
2088function TTemplate.ItemIENs: string;
2089var
2090 i: integer;
2091
2092begin
2093 GetItems;
2094 Result := '';
2095 for i := 0 to FItems.Count-1 do
2096 Result := Result + TTemplate(FItems[i]).FID+',';
2097end;
2098
2099function TemplateChildrenCompare(Item1, Item2: Pointer): Integer;
2100begin
2101 Result := CompareText(TTemplate(Item1).PrintName,TTemplate(Item2).PrintName);
2102end;
2103
2104procedure TTemplate.SortChildren;
2105begin
2106 GetItems;
2107 if (FItems.Count > 1) and CanModify then
2108 FItems.Sort(TemplateChildrenCompare);
2109end;
2110
2111procedure TTemplate.BackupItems;
2112begin
2113 with FBkup do
2114 begin
2115 if((not SavedItemIENs) and assigned(FItems)) then
2116 begin
2117 BItemIENs := ItemIENs;
2118 SavedItemIENs := TRUE;
2119 end;
2120 end;
2121end;
2122
2123procedure TTemplate.SetActive(const Value: boolean);
2124begin
2125 if(FActive <> Value) and CanModify then
2126 begin
2127 with FBkup do
2128 begin
2129 if(not SavedActive) and ValidID then
2130 begin
2131 BActive := FActive;
2132 SavedActive := TRUE;
2133 end;
2134 end;
2135 FActive := Value;
2136 end;
2137end;
2138
2139procedure TTemplate.SetExclude(const Value: boolean);
2140begin
2141 if(FExclude <> Value) and CanModify then
2142 begin
2143 with FBkup do
2144 begin
2145 if(not SavedExclude) and ValidID then
2146 begin
2147 BExclude := FExclude;
2148 SavedExclude := TRUE;
2149 end;
2150 end;
2151 FExclude := Value;
2152 end;
2153end;
2154
2155procedure TTemplate.SetDialog(const Value: boolean);
2156begin
2157 if(FDialog <> Value) and CanModify then
2158 begin
2159 with FBkup do
2160 begin
2161 if(not SavedDialog) and ValidID then
2162 begin
2163 BDialog := FDialog;
2164 SavedDialog := TRUE;
2165 end;
2166 end;
2167 FDialog := Value;
2168 end;
2169end;
2170
2171procedure TTemplate.SetGap(const Value: integer);
2172begin
2173 if(FGap <> Value) and CanModify then
2174 begin
2175 with FBkup do
2176 begin
2177 if(not SavedGap) and ValidID then
2178 begin
2179 BGap := FGap;
2180 SavedGap := TRUE;
2181 end;
2182 end;
2183 FGap := Value;
2184 end;
2185end;
2186
2187procedure TTemplate.SetPrintName(const Value: string);
2188begin
2189 if(FPrintName <> Value) and CanModify then
2190 begin
2191 with FBkup do
2192 begin
2193 if(not SavedPrintName) and ValidID then
2194 begin
2195 BPrintName := FPrintName;
2196 SavedPrintName := TRUE;
2197 end;
2198 end;
2199 FPrintName := Value;
2200 end;
2201end;
2202
2203procedure TTemplate.SetRealType(const Value: TTemplateType);
2204begin
2205 if(FRealType <> Value) and CanModify then
2206 begin
2207 with FBkup do
2208 begin
2209 if(not SavedRealType) and ValidID then
2210 begin
2211 BRealType := FRealType;
2212 SavedRealType := TRUE;
2213 end;
2214 end;
2215 FRealType := Value;
2216 if(FFileLink <> '') and (not (FRealType in [ttDoc, ttGroup])) then
2217 SetFileLink('');
2218 end;
2219end;
2220
2221procedure TTemplate.ClearBackup(ClearItemIENs: boolean = TRUE);
2222begin
2223 with FBkup do
2224 begin
2225 SavedPrintName := FALSE;
2226 SavedGap := FALSE;
2227 SavedRealType := FALSE;
2228 SavedActive := FALSE;
2229 SavedDisplayOnly := FALSE;
2230 SavedFirstLine := FALSE;
2231 SavedOneItemOnly := FALSE;
2232 SavedHideDlgItems := FALSE;
2233 SavedHideItems := FALSE;
2234 SavedIndentItems := FALSE;
2235 SavedLock := FALSE;
2236 SavedExclude := FALSE;
2237 SavedDialog := FALSE;
2238 SavedPersonalOwner := FALSE;
2239 SavedBoilerPlate := FALSE;
2240 SavedDescription := FALSE;
2241 SavedReminderDialog := FALSE;
2242 SavedCOMObject := FALSE;
2243 SavedCOMParam := FALSE;
2244 SavedFileLink := FALSE;
2245 if(ClearItemIENs) then
2246 begin
2247 if(FExpanded) then
2248 begin
2249 BItemIENs := ItemIENs;
2250 SavedItemIENs := TRUE;
2251 end
2252 else
2253 SavedItemIENs := FALSE;
2254 end;
2255 end;
2256end;
2257
2258function TTemplate.Changed: boolean;
2259begin
2260 Result := not ValidID;
2261 with FBkup do
2262 begin
2263 if(not Result) and (SavedPrintName) then Result := (BPrintName <> FPrintName);
2264 if(not Result) and (SavedGap) then Result := (BGap <> FGap);
2265 if(not Result) and (SavedRealType) then Result := (BRealType <> FRealType);
2266 if(not Result) and (SavedActive) then Result := (BActive <> FActive);
2267 if(not Result) and (SavedDisplayOnly) then Result := (BDisplayOnly <> FDisplayOnly);
2268 if(not Result) and (SavedFirstLine) then Result := (BFirstLine <> FFirstLine);
2269 if(not Result) and (SavedOneItemOnly) then Result := (BOneItemOnly <> FOneItemOnly);
2270 if(not Result) and (SavedHideDlgItems) then Result := (BHideDlgItems <> FHideDlgItems);
2271 if(not Result) and (SavedHideItems) then Result := (BHideItems <> FHideItems);
2272 if(not Result) and (SavedIndentItems) then Result := (BIndentItems <> FIndentItems);
2273 if(not Result) and (SavedLock) then Result := (BLock <> FLock);
2274 if(not Result) and (SavedExclude) then Result := (BExclude <> FExclude);
2275 if(not Result) and (SavedDialog) then Result := (BDialog <> FDialog);
2276 if(not Result) and (SavedPersonalOwner) then Result := (BPersonalOwner <> FPersonalOwner);
2277 if(not Result) and (SavedReminderDialog) then Result := (BReminderDialog <> FReminderDialog);
2278 if(not Result) and (SavedCOMObject) then Result := (BCOMObject <> FCOMObject);
2279 if(not Result) and (SavedCOMParam) then Result := (BCOMParam <> FCOMParam);
2280 if(not Result) and (SavedFileLink) then Result := (BFileLink <> FFileLink);
2281 if(not Result) and (SavedBoilerplate) then Result := (BBoilerplate <> FBoilerplate);
2282 if(not Result) and (SavedDescription) then Result := (BDescription <> FDescription);
2283 if(not Result) and (SavedItemIENs) then Result := (BItemIENs <> ItemIENs); // Keep last
2284 end;
2285end;
2286
2287procedure TTemplate.SetDescription(const Value: string);
2288begin
2289 if(FDescription <> Value) and CanModify then
2290 begin
2291 with FBkup do
2292 begin
2293 if(FDescriptionLoaded and (not SavedDescription) and ValidID) then
2294 begin
2295 BDescription := FDescription;
2296 SavedDescription := TRUE;
2297 end;
2298 end;
2299 FDescription := Value;
2300 end;
2301 FDescriptionLoaded := TRUE;
2302end;
2303
2304function TTemplate.GetDescription: string;
2305begin
2306 if(not FDescriptionLoaded) then
2307 begin
2308// StatusText('Loading Template Boilerplate...'); <-- original line. //kt 8/8/2007
2309 StatusText(DKLangConstW('uTemplates_Loading_Template_Boilerplatexxx')); //kt added 8/8/2007
2310 try
2311 LoadTemplateDescription(FID);
2312 FDescription := RPCBrokerV.Results.Text;
2313 finally
2314 StatusText('');
2315 end;
2316 FDescriptionLoaded := TRUE;
2317 end;
2318 Result := FDescription;
2319end;
2320
2321procedure TTemplate.SetDisplayOnly(const Value: boolean);
2322begin
2323 if(FDisplayOnly <> Value) and CanModify then
2324 begin
2325 with FBkup do
2326 begin
2327 if(not SavedDisplayOnly) and ValidID then
2328 begin
2329 BDisplayOnly := FDisplayOnly;
2330 SavedDisplayOnly := TRUE;
2331 end;
2332 end;
2333 FDisplayOnly := Value;
2334 end;
2335end;
2336
2337procedure TTemplate.SetFirstLine(const Value: boolean);
2338begin
2339 if(FFirstLine <> Value) and CanModify then
2340 begin
2341 with FBkup do
2342 begin
2343 if(not SavedFirstLine) and ValidID then
2344 begin
2345 BFirstLine := FFirstLine;
2346 SavedFirstLine := TRUE;
2347 end;
2348 end;
2349 FFirstLine := Value;
2350 end;
2351end;
2352
2353procedure TTemplate.SetHideItems(const Value: boolean);
2354begin
2355 if(FHideItems <> Value) and CanModify then
2356 begin
2357 with FBkup do
2358 begin
2359 if(not SavedHideItems) and ValidID then
2360 begin
2361 BHideItems := FHideItems;
2362 SavedHideItems := TRUE;
2363 end;
2364 end;
2365 FHideItems := Value;
2366 end;
2367end;
2368
2369procedure TTemplate.SetIndentItems(const Value: boolean);
2370begin
2371 if(FIndentItems <> Value) and CanModify then
2372 begin
2373 with FBkup do
2374 begin
2375 if(not SavedIndentItems) and ValidID then
2376 begin
2377 BIndentItems := FIndentItems;
2378 SavedIndentItems := TRUE;
2379 end;
2380 end;
2381 FIndentItems := Value;
2382 end;
2383end;
2384
2385procedure TTemplate.SetOneItemOnly(const Value: boolean);
2386begin
2387 if(FOneItemOnly <> Value) and CanModify then
2388 begin
2389 with FBkup do
2390 begin
2391 if(not SavedOneItemOnly) and ValidID then
2392 begin
2393 BOneItemOnly := FOneItemOnly;
2394 SavedOneItemOnly := TRUE;
2395 end;
2396 end;
2397 FOneItemOnly := Value;
2398 end;
2399end;
2400
2401procedure TTemplate.SetHideDlgItems(const Value: boolean);
2402begin
2403 if(FHideDlgItems <> Value) and CanModify then
2404 begin
2405 with FBkup do
2406 begin
2407 if(not SavedHideDlgItems) and ValidID then
2408 begin
2409 BHideDlgItems := FHideDlgItems;
2410 SavedHideDlgItems := TRUE;
2411 end;
2412 end;
2413 FHideDlgItems := Value;
2414 end;
2415end;
2416
2417function TTemplate.DlgID: string;
2418begin
2419 Result := IntToStr(StrToIntDef(FID, 0));
2420 if(Result = '0') then
2421 begin
2422 if(FLastDlgCnt <> uDlgCount) then
2423 begin
2424 FLastDlgCnt := uDlgCount;
2425 inc(uUniqueIDNum);
2426 FLastUniqueID := uUniqueIDNum;
2427 end;
2428 Result := '-' + inttostr(FLastUniqueID);
2429 end;
2430end;
2431
2432function TTemplate.DialogProperties(Parent: TTemplate = nil): string;
2433var
2434 Show, ToggleItems: boolean;
2435 bGap: integer;
2436 GroupIdx: string;
2437
2438begin
2439 GroupIdx := '0';
2440 bGap := 0;
2441 if(assigned(parent)) then
2442 begin
2443 Show := ((not Parent.HideDlgItems) or (Parent.Boilerplate = ''));
2444// if(Parent.Boilerplate <> '') and (Parent.OneItemOnly) then
2445 if(Parent.OneItemOnly) then
2446 GroupIdx := Parent.DlgID;
2447 if(Parent.RealType = ttGroup) then
2448 bGap := Parent.Gap;
2449 end
2450 else
2451 Show := TRUE;
2452
2453 ToggleItems := ((HideDlgItems) and (Boilerplate <> ''));
2454
2455 Result := BOOLCHAR[DisplayOnly] +
2456 BOOLCHAR[FirstLine] +
2457 BOOLCHAR[Show] +
2458 BOOLCHAR[ToggleItems] +
2459 IntToStr(bGap) + // Depends on Gap being 1 character in length
2460 ';' + GroupIdx + ';' + DlgID;
2461 if(assigned(Parent)) then
2462 SetPiece(Result, ';', 4, Parent.DlgID);
2463 SetPiece(Result,';',5, inttostr(uIndentLevel));
2464end;
2465
2466function TTemplate.GetDialogAborted: boolean;
2467begin
2468 Result := FDialogAborted;
2469 FDialogAborted := FALSE;
2470end;
2471
2472function TTemplate.IsDialog: boolean;
2473begin
2474 Result := (FDialog and (FRealType = ttGroup));
2475end;
2476
2477function TTemplate.CanExportXML(Data, Fields: TStringList; IndentLevel: integer = 0): boolean;
2478var
2479 Pad, Tmp: string;
2480 i: integer;
2481
2482begin
2483 if BadTemplateName(PrintName) then
2484 begin
2485// InfoBox('Can not export template.' + CRLF + 'Template has an invalid name: ' + <-- original line. //kt 8/8/2007
2486 InfoBox(DKLangConstW('uTemplates_Can_not_export_templatex') + CRLF + DKLangConstW('uTemplates_Template_has_an_invalid_namex') + //kt added 8/8/2007
2487// PrintName + '.' + BadNameText, 'Error', MB_OK or MB_ICONERROR); <-- original line. //kt 8/8/2007
2488 PrintName + '.' + BadNameText, DKLangConstW('uTemplates_Error'), MB_OK or MB_ICONERROR); //kt added 8/8/2007
2489 Result := FALSE;
2490 exit;
2491 end;
2492 Result := TRUE;
2493 Pad := StringOfChar(' ',IndentLevel);
2494 Data.Add(Pad + '<' + XMLTemplateTag + ' ' + TemplateExportTag[efName] + '="' + Text2XML(PrintName) + '">');
2495 AddXMLData(Data, Pad, efBlankLines, IntToStr(Gap), '0');
2496 if(RealType in AllTemplateRootTypes) then
2497 Tmp := TemplateTypeCodes[ttClass]
2498 else
2499 Tmp := TemplateTypeCodes[RealType];
2500 AddXMLData(Data, Pad, efType, Tmp, '');
2501 AddXMLData(Data, Pad, efStatus, TemplateActiveCode[Active], '');
2502 AddXMLBool(Data, Pad, efExclude, Exclude);
2503 AddXMLBool(Data, Pad, efDialog, Dialog);
2504 AddXMLBool(Data, Pad, efDisplayOnly, DisplayOnly);
2505 AddXMLBool(Data, Pad, efFirstLine, FirstLine);
2506 AddXMLBool(Data, Pad, efOneItemOnly, OneItemOnly);
2507 AddXMLBool(Data, Pad, efHideDialogItems, HideDlgItems);
2508 AddXMLBool(Data, Pad, efHideTreeItems, HideItems);
2509 AddXMLBool(Data, Pad, efIndentItems, IndentItems);
2510 AddXMLBool(Data, Pad, efLock, Lock);
2511 AddXMLList(Data, Fields, Pad, efBoilerplate, GetBoilerplate);
2512 AddXMLList(Data, Fields, Pad, efDescription, GetDescription);
2513 GetItems;
2514 if(FItems.Count > 0) then
2515 begin
2516 Data.Add(Pad + ' <' + TemplateExportTag[efItems] + '>');
2517 for i := 0 to FItems.Count-1 do
2518 begin
2519 Result := TTemplate(FItems[i]).CanExportXML(Data, Fields, IndentLevel + 4);
2520 if(not Result) then exit;
2521 end;
2522 Data.Add(Pad + ' </' + TemplateExportTag[efItems] + '>');
2523 end;
2524 Data.Add(Pad + '</' + XMLTemplateTag + '>');
2525end;
2526
2527procedure TTemplate.UpdateImportedFieldNames(List: TStrings);
2528const
2529 SafeCode = #1 + '^@^' + #2;
2530 SafeCodeLen = length(SafeCode);
2531
2532var
2533 i, p, l1: integer;
2534 Tag1, Tag2, tmp: string;
2535 First, ok: boolean;
2536
2537begin
2538 GetBoilerplate;
2539 ok := TRUE;
2540 First := TRUE;
2541 for i := 0 to List.Count-1 do
2542 begin
2543 if(Piece(List[i],U,2) = '0') then
2544 begin
2545 Tag1 := TemplateFieldBeginSignature + Piece(List[i],U,1) + TemplateFieldEndSignature;
2546 Tag2 := TemplateFieldBeginSignature + SafeCode + Piece(List[i],U,3) + TemplateFieldEndSignature;
2547 l1 := length(Tag1);
2548 repeat
2549 p := pos(Tag1, FBoilerplate);
2550 if(p > 0) then
2551 begin
2552 if First then
2553 begin
2554 ok := CanModify;
2555 First := FALSE;
2556 end;
2557 if ok then
2558 begin
2559 tmp := copy(FBoilerplate,1,p-1) + Tag2 + copy(FBoilerplate,p+l1, MaxInt);
2560 FBoilerplate := tmp;
2561 end
2562 else
2563 p := 0;
2564 end;
2565 until (p = 0);
2566 end;
2567 if not ok then break;
2568 end;
2569 if ok then
2570 begin
2571 repeat
2572 p := pos(SafeCode, FBoilerplate);
2573 if(p > 0) then
2574 delete(FBoilerplate, p, SafeCodeLen);
2575 until (p = 0);
2576 GetItems;
2577 for i := 0 to FItems.Count-1 do
2578 TTemplate(FItems[i]).UpdateImportedFieldNames(List);
2579 end;
2580end;
2581
2582procedure TTemplate.SetReminderDialog(const Value: string);
2583begin
2584 if(FReminderDialog <> Value) and CanModify then
2585 begin
2586 with FBkup do
2587 begin
2588 if(not SavedReminderDialog) and ValidID then
2589 begin
2590 BReminderDialog := FReminderDialog;
2591 SavedReminderDialog := TRUE;
2592 end;
2593 end;
2594 FReminderDialog := Value;
2595 FIsReminderDialog := (ReminderDialogIEN <> '');
2596 if FIsReminderDialog and (not (LinkType in [ltNone, ltTitle])) then
2597 SetFileLink('');
2598 end;
2599end;
2600
2601function TTemplate.ReminderDialogIEN: string;
2602begin
2603 Result := Piece(FReminderDialog,U,1);
2604 if Result = '0' then
2605 Result := '';
2606end;
2607
2608function TTemplate.ReminderDialogName: string;
2609begin
2610 Result := Piece(FReminderDialog,U,2);
2611end;
2612
2613function TTemplate.CanModify: boolean;
2614begin
2615 if(not FLocked) and ValidID and (not FCloning) then
2616 begin
2617 FLocked := LockTemplate(FID);
2618 Result := FLocked;
2619 if(not FLocked) then
2620 begin
2621 if(assigned(dmodShared.OnTemplateLock)) then
2622 dmodShared.OnTemplateLock(Self)
2623 else
2624 ShowMessage(Format(TemplateLockedText, [FPrintName]));
2625 end;
2626 end
2627 else
2628 Result := TRUE;
2629end;
2630
2631function TTemplate.ValidID: boolean;
2632begin
2633 Result := ((FID <> '0') and (FID <> ''));
2634end;
2635
2636procedure TTemplate.Unlock;
2637begin
2638 if FLocked and ValidID then
2639 begin
2640 UnlockTemplate(FID);
2641 FLocked := FALSE;
2642 end;
2643end;
2644
2645procedure TTemplate.SetLock(const Value: boolean);
2646begin
2647 if(FLock <> Value) and CanModify then
2648 begin
2649 with FBkup do
2650 begin
2651 if(not SavedLock) and ValidID then
2652 begin
2653 BLock := FLock;
2654 SavedLock := TRUE;
2655 end;
2656 end;
2657 FLock := Value;
2658 end;
2659end;
2660
2661function TTemplate.IsLocked: boolean;
2662begin
2663 Result := (FLock and (FPersonalOwner = 0)) or AutoLock;
2664end;
2665
2666procedure TTemplate.SetCOMObject(const Value: integer);
2667begin
2668 if(FCOMObject <> Value) and CanModify then
2669 begin
2670 with FBkup do
2671 begin
2672 if(not SavedCOMObject) and ValidID then
2673 begin
2674 BCOMObject := FCOMObject;
2675 SavedCOMObject := TRUE;
2676 end;
2677 end;
2678 FCOMObject := Value;
2679 FIsCOMObject := (FCOMObject > 0);
2680 end;
2681end;
2682
2683procedure TTemplate.SetCOMParam(const Value: string);
2684begin
2685 if(FCOMParam <> Value) and CanModify then
2686 begin
2687 with FBkup do
2688 begin
2689 if(not SavedCOMParam) and ValidID then
2690 begin
2691 BCOMParam := FCOMParam;
2692 SavedCOMParam := TRUE;
2693 end;
2694 end;
2695 FCOMParam := Value;
2696 end;
2697end;
2698
2699procedure TTemplate.AssignFileLink(const Value: string; Force: boolean);
2700var
2701 i: integer;
2702 DoItems: boolean;
2703
2704begin
2705 DoItems := Force;
2706 if(FFileLink <> Value) and CanModify then
2707 begin
2708 with FBkup do
2709 begin
2710 if(not SavedFileLink) and ValidID then
2711 begin
2712 BFileLink := FFileLink;
2713 SavedFileLink := TRUE;
2714 end;
2715 end;
2716 FFileLink := Value;
2717 FLinkName := '';
2718 if (not (LinkType in [ltNone, ltTitle])) then
2719 SetReminderDialog('');
2720 if not DoItems then
2721 DoItems := (FFileLink <> '');
2722 end;
2723 if DoItems then
2724 begin
2725 GetItems;
2726 for i := 0 to FItems.Count-1 do
2727 TTemplate(FItems[i]).AssignFileLink('', TRUE);
2728 end;
2729end;
2730
2731procedure TTemplate.SetFileLink(const Value: string);
2732begin
2733 AssignFileLink(Value, FALSE);
2734end;
2735
2736//function TTemplate.COMObjectText(const DefText: string = ''; DocInfo: string = ''): string;
2737function TTemplate.COMObjectText(DefText: string; var DocInfo: string): string;
2738var
2739 p2: string;
2740
2741begin
2742 Result := '';
2743 if (FCOMObject > 0) then
2744 begin
2745 p2 := '';
2746 if (LinkType <> ltNone) and (LinkIEN <> '') then
2747 p2 := LinkPassCode[LinkType] + '=' + LinkIEN;
2748 Result := DefText;
2749 GetCOMObjectText(FCOMObject, p2, FCOMParam, Result, DocInfo);
2750 end;
2751end;
2752
2753function TTemplate.AutoLock: boolean;
2754begin
2755 Result := FIsCOMObject;
2756 if (not Result) and (not (RealType in AllTemplateLinkTypes)) and (LinkType <> ltNone) then
2757 Result := TRUE;
2758end;
2759
2760function TTemplate.LinkType: TTemplateLinkType;
2761var
2762 idx: TTemplateLinkType;
2763
2764begin
2765 Result := ltNone;
2766 case FRealType of
2767 ttTitles: Result := ltTitle;
2768 ttConsults: Result := ltConsult;
2769 ttProcedures: Result := ltProcedure;
2770 else
2771 begin
2772 for idx := succ(low(TTemplateLinkType)) to high(TTemplateLinkType) do
2773 begin
2774 if pos(LinkGlobal[idx], FFileLink) > 0 then
2775 begin
2776 Result := idx;
2777 break;
2778 end;
2779 end;
2780 end;
2781 end;
2782end;
2783
2784function TTemplate.LinkIEN: string;
2785begin
2786 Result := piece(FFileLink,';',1);
2787end;
2788
2789function TTemplate.LinkName: string;
2790begin
2791 if FLinkName = '' then
2792 FLinkName := GetLinkName(LinkIEN, LinkType);
2793 Result := FLinkName;
2794end;
2795
2796procedure TTemplate.ExecuteReminderDialog(OwningForm: TForm);
2797var
2798 sts: integer;
2799 txt: string;
2800
2801begin
2802 sts := IsRemDlgAllowed(ReminderDialogIEN);
2803 txt := '';
2804 if sts < 0 then
2805// txt := 'Reminder Dialog has been Deleted or Deactivated.' <-- original line. //kt 8/8/2007
2806 txt := DKLangConstW('uTemplates_Reminder_Dialog_has_been_Deleted_or_Deactivatedx') //kt added 8/8/2007
2807 else
2808 if sts = 0 then
2809// txt := 'You are not Authorized to use this Reminder Dialog in a Template' <-- original line. //kt 8/8/2007
2810 txt := DKLangConstW('uTemplates_You_are_not_Authorized_to_use_this_Reminder_Dialog_in_a_Template') //kt added 8/8/2007
2811 else
2812 ViewRemDlgTemplateFromForm(OwningForm, Self, TRUE, TRUE);
2813 if txt <> '' then
2814// InfoBox(txt,'Can not use Reminder Dialog', MB_OK or MB_ICONERROR); <-- original line. //kt 8/8/2007
2815 InfoBox(txt,DKLangConstW('uTemplates_Can_not_use_Reminder_Dialog'), MB_OK or MB_ICONERROR); //kt added 8/8/2007
2816end;
2817
2818procedure ExpandEmbeddedFields(flds: TStringList);
2819{07/26/01 S Monson Procedure to take a list of fields and expand it with any
2820 embedded fields. Handles embedded field loops
2821 (self referencing loops.)}
2822var
2823 i,pos1,pos2: integer;
2824 ifield: TTemplateField;
2825 estring,next: string;
2826begin
2827 if flds.count < 1 then
2828 Exit;
2829 i := 0;
2830 repeat
2831 ifield := GetTemplateField(flds[i],False);
2832 if ifield <> nil then
2833 begin
2834 estring := '';
2835 case ifield.FldType of
2836 dftText,dftComboBox,dftButton,
2837 dftCheckBoxes,dftRadioButtons: estring := ifield.items;
2838 dftHyperlink: estring := ifield.EditDefault;
2839 end;
2840 while (estring <> '') do
2841 begin
2842 pos1 := pos(TemplateFieldBeginSignature,estring);
2843 if pos1 > 0 then
2844 begin
2845 estring := copy(estring,(pos1 + length(TemplateFieldBeginSignature)),maxint);
2846 pos2 := pos(TemplateFieldEndSignature,estring);
2847 if pos2 > 0 then
2848 begin
2849 next := copy(estring,1,pos2-1);
2850 delete(estring,1,pos2-1+length(TemplateFieldEndSignature));
2851 if flds.IndexOf(next) < 0 then
2852 flds.add(next);
2853 end
2854 else
2855 estring := '';
2856 end
2857 else
2858 estring := '';
2859 end;
2860 inc(i);
2861 end
2862 else
2863 flds.Delete(i);
2864 until (i > flds.count-1);
2865end;
2866
2867function MakeXMLParamTIU(ANoteID: string; ANoteRec: TEditNoteRec): string;
2868var
2869 tmpList: TStringList;
2870begin
2871 tmpList := TStringList.Create;
2872 try
2873 tmpList.Add('<TIU_DOC>');
2874 tmpList.Add(' <DOC_IEN>' + ANoteID + '</DOC_IEN>');
2875 tmpList.Add(' <AUTHOR_IEN>' + IntToStr(ANoteRec.Author) + '</AUTHOR_IEN>');
2876 tmpList.Add(' <AUTHOR_NAME>' + ExternalName(ANoteRec.Author, 200) + '</AUTHOR_NAME>');
2877 tmpList.Add('</TIU_DOC>');
2878 finally
2879 Result := tmpList.Text;
2880 tmpList.Free;
2881 end;
2882end;
2883
2884function MakeXMLParamTIU(ADCSummID: string; ADCSummRec: TEditDCSummRec): string;
2885var
2886 tmpList: TStringList;
2887begin
2888 tmpList := TStringList.Create;
2889 try
2890 tmpList.Add('<TIU_DOC>');
2891 tmpList.Add(' <DOC_IEN>' + ADCSummID + '</DOC_IEN>');
2892 tmpList.Add(' <AUTHOR_IEN>' + IntToStr(ADCSummRec.Dictator) + '</AUTHOR_IEN>');
2893 tmpList.Add(' <AUTHOR_NAME>' + ExternalName(ADCSummRec.Dictator, 200) + '</AUTHOR_NAME>');
2894 tmpList.Add('</TIU_DOC>');
2895 finally
2896 Result := tmpList.Text;
2897 tmpList.Free;
2898 end;
2899end;
2900
2901function GetXMLParamReturnValueTIU(DocInfo, ParamTag: string): string;
2902var
2903 XMLDoc: IXMLDOMDocument;
2904 RootElement: IXMLDOMElement;
2905 TagElement: IXMLDOMNode;
2906
2907const
2908//NoIE5 = 'You must have Internet Explorer 5 or better installed to %s Templates'; <-- original line. //kt 8/8/2007
2909//NoIE5Header = 'Need Internet Explorer 5'; <-- original line. //kt 8/8/2007
2910 TIUHeader = 'TIU_DOC';
2911
2912var
2913 NoIE5 : string; //kt
2914 NoIE5Header : string; //kt
2915
2916begin
2917 NoIE5 := DKLangConstW('uTemplates_You_must_have_Internet_Explorer_5_or_better_installed_to_xs_Templates'); //kt added 8/8/2007
2918 NoIE5Header := DKLangConstW('uTemplates_Need_Internet_Explorer_5'); //kt added 8/8/2007
2919// After ExecuteTemplateOrBoilerPlate, DocInfo parameter may contain return value of AUTHOR.
2920// Call this function at that point to get the value from the XML formatted parameter that's returned.
2921 Result := '';
2922 try
2923 XMLDoc := CoDOMDocument.Create;
2924 except
2925// InfoBox(Format(NoIE5, ['use COM']), NoIE5Header, MB_OK); <-- original line. //kt 8/8/2007
2926 InfoBox(Format(NoIE5, [DKLangConstW('uTemplates_use_COM')]), NoIE5Header, MB_OK); //kt added 8/8/2007
2927 exit;
2928 end;
2929 try
2930 if assigned(XMLDoc) then
2931 begin
2932 XMLDoc.preserveWhiteSpace := TRUE;
2933 if DocInfo <> '' then
2934 XMLDoc.LoadXML(DocInfo);
2935 RootElement := XMLDoc.DocumentElement;
2936 if not assigned(RootElement) then exit;
2937 try
2938 if(RootElement.tagName <> TIUHeader) then exit
2939 else
2940 begin
2941 TagElement := FindXMLElement(RootElement, ParamTag);
2942 if assigned(TagElement) then
2943 Result := TagElement.Text
2944 else Result := '';
2945 end;
2946 finally
2947 TagElement := nil;
2948 RootElement := nil;
2949 end;
2950 end;
2951 finally
2952 XMLDoc := nil;
2953 end;
2954end;
2955
2956function TTemplate.ReminderWipe: string;
2957begin
2958 Result := Piece(FReminderDialog,U,3);
2959end;
2960
2961initialization
2962
2963finalization
2964 ReleaseTemplates;
2965
2966end.
Note: See TracBrowser for help on using the repository browser.