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

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

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