source: cprs/trunk/CPRS-Chart/Templates/uTemplates.pas@ 1742

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

Upgrade to version 27

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