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

Last change on this file since 454 was 453, checked in by Kevin Toppenberg, 16 years ago

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