unit uTemplates; {$O-} interface uses Classes, Controls, SysUtils, Forms, ORFn, ORNet, Dialogs, MSXML_TLB, uTIU, uDCSumm, Variants; type TTemplateType = (ttNone, ttMyRoot, ttRoot, ttTitles, ttConsults, ttProcedures, ttClass, ttDoc, ttGroup, ttDocEx, ttGroupEx); TTemplateLinkTypes = ttTitles..ttProcedures; const AllTemplateLinkTypes = [ttTitles..ttProcedures]; AllTemplateRootTypes = [ttMyRoot, ttRoot, ttTitles, ttConsults, ttProcedures]; AllTemplateTrueTypes = AllTemplateRootTypes + [ttNone, ttClass]; AllTemplateFolderTypes = AllTemplateRootTypes + [ttGroup, ttClass]; type TTemplateChildren = (tcNone, tcActive, tcInactive, tcBoth); TTemplateAccess = (taAll, taReadOnly, taNone, taEditor); TTemplateLinkType = (ltNone, ltTitle, ltConsult, ltProcedure); TTemplateBackup = record BPrintName: string; BGap: integer; BRealType: TTemplateType; BActive: boolean; BDisplayOnly: boolean; BFirstLine: boolean; BOneItemOnly: boolean; BHideDlgItems: boolean; BHideItems: boolean; BIndentItems: boolean; BExclude: boolean; BDialog: boolean; BPersonalOwner: Int64; BBoilerPlate: string; BItemIENs: string; BDescription: string; BReminderDialog: string; BLock: boolean; BCOMObject: integer; BCOMParam: string; BFileLink: string; SavedPrintName: boolean; SavedGap: boolean; SavedRealType: boolean; SavedActive: boolean; SavedDisplayOnly: boolean; SavedFirstLine: boolean; SavedOneItemOnly: boolean; SavedHideDlgItems: boolean; SavedHideItems: boolean; SavedIndentItems: boolean; SavedExclude: boolean; SavedDialog: boolean; SavedPersonalOwner: boolean; SavedBoilerPlate: boolean; SavedItemIENs: boolean; SavedDescription: boolean; SavedReminderDialog: boolean; SavedLock: boolean; SavedCOMObject: boolean; SavedCOMParam: boolean; SavedFileLink: boolean; end; TTemplate = class(TObject) private FDescriptionLoaded: boolean; // Template Notes Loaded Flag FDescription: string; // Template Notes FCreatingChildren: boolean; // Flag used to prevent infinite recursion FExclude: boolean; // Exclude from group boilerplate FActive: boolean; FDisplayOnly: boolean; // Suppresses checkbox in dialog - no PN text FFirstLine: boolean; // Display only the first line in a dialog box FOneItemOnly: boolean; // Allow only one Child Item to be selected in dialog FHideDlgItems: boolean; // Hide Child Items when not checked FHideItems: boolean; // Hide items in Templates Drawer Tree FIndentItems: boolean; // Indent Items in dialog only FLock: boolean; // Locks Shared Templates FDialog: boolean; // Determines if Group is a Dialog FBoilerPlateLoaded: boolean; // Boilerplate Loaded Flag FBoilerplate: string; // Boilerplate FID: string; // Template IEN FPrintName: string; // Template Name FItems: TList; // Holds pointers to children templates FNodes: TStringList; // Holds tree nodes that reference the template // string value is tmp index used for syncing FRealType: TTemplateType; // Real Template Type (from the template file) FGap: integer; // Number of blank lines to insert between items FChildren: TTemplateChildren; // flag indicating the active status of children FPersonalOwner: Int64; // owner DUZ FExpanded: boolean; // Indicates children have been read from server FTag: longint; // Used internally for syncing FLastTagIndex: longint; // Used internally for syncing FBkup: TTemplateBackup; // Backup values to determine what needs to be saved FLastDlgCnt: longint; FLastUniqueID: longint; FDialogAborted: boolean; // Flag indicating Cancel was pressed on the dialog FReminderDialog: string; // Reminder Dialog IEN ^ Reminder Dialog Name FIsReminderDialog: boolean; // Flag used internally for setting Type FIsCOMObject: boolean; // Flag used internally for setting Type FLocked: boolean; // Flag Indicating Template is locked FCOMObject: integer; // COM Object IEN FCOMParam: string; // Param to pass to COM Object FFileLink: string; // Used to link templates to Titles and Reasons for Request FLinkName: string; FCloning: boolean; // Flag used to prevent locking during the cloning process FPreviewMode: boolean; // Flag to prevent "Are you sure you want to cancel?" dialog when previewing protected function TrueClone: TTemplate; function GetItems: TList; function GetTemplateType: TTemplateType; function GetBoilerplate: string; function GetChildren: TTemplateChildren; procedure SetTemplateType(const Value: TTemplateType); procedure SetBoilerplate(Value: string); function GetText: string; procedure SetPersonalOwner(Value: Int64); procedure SetActive(const Value: boolean); procedure SetDisplayOnly(const Value: boolean); procedure SetFirstLine(const Value: boolean); procedure SetOneItemOnly(const Value: boolean); procedure SetHideDlgItems(const Value: boolean); procedure SetHideItems(const Value: boolean); procedure SetIndentItems(const Value: boolean); procedure SetLock(const Value: boolean); procedure SetExclude(const Value: boolean); procedure SetDialog(const Value: boolean); procedure SetGap(const Value: integer); procedure SetPrintName(const Value: string); procedure SetRealType(const Value: TTemplateType); procedure ClearBackup(ClearItemIENs: boolean = TRUE); procedure SetDescription(const Value: string); function GetDescription: string; function GetDialogAborted: boolean; procedure SetReminderDialog(const Value: string); // Reminder Dialog IEN procedure SetCOMObject(const Value: integer); procedure SetCOMParam(const Value: string); procedure AssignFileLink(const Value: string; Force: boolean); procedure SetFileLink(const Value: string); function ValidID: boolean; public constructor Create(DataString: string); class function CreateFromXML(Element: IXMLDOMNode; Owner: string): TTemplate; destructor Destroy; override; function CanModify: boolean; procedure Unlock; procedure AddNode(Node: Pointer); procedure RemoveNode(Node: Pointer); procedure AddChild(Child: TTemplate); procedure RemoveChild(Child: TTemplate); function Clone(Owner: Int64): TTemplate; function ItemBoilerplate: string; function FullBoilerplate: string; function ItemIENs: string; procedure BackupItems; procedure SortChildren; function Changed: boolean; function DialogProperties(Parent: TTemplate = nil): string; function DlgID: string; function IsDialog: boolean; function CanExportXML(Data, Fields: TStringList; IndentLevel: integer = 0): boolean; function ReminderDialogIEN: string; function ReminderDialogName: string; function ReminderWipe: string; //AGP Change 24.8 function IsLocked: boolean; procedure UpdateImportedFieldNames(List: TStrings); //function COMObjectText(const DefText: string = ''; DocInfo: string = ''): string; function COMObjectText(DefText: string; var DocInfo: string): string; function AutoLock: boolean; function LinkType: TTemplateLinkType; function LinkIEN: string; function LinkName: string; procedure ExecuteReminderDialog(OwningForm: TForm); property Nodes: TStringList read FNodes; property ID: string read FID; property PrintName: string read FPrintName write SetPrintName; property RealType: TTemplateType read FRealType write SetRealType; property TemplateType: TTemplateType read GetTemplateType write SetTemplateType; property Active: boolean read FActive write SetActive; property DisplayOnly: boolean read FDisplayOnly write SetDisplayOnly; property FirstLine: boolean read FFirstLine write SetFirstLine; property OneItemOnly: boolean read FOneItemOnly write SetOneItemOnly; property HideDlgItems: boolean read FHideDlgItems write SetHideDlgItems; property HideItems: boolean read FHideItems write SetHideItems; property IndentItems: boolean read FIndentItems write SetIndentItems; property Lock: boolean read FLock write SetLock; property Exclude: boolean read FExclude write SetExclude; property Dialog: boolean read FDialog write SetDialog; property Boilerplate: string read GetBoilerplate write SetBoilerplate; property Children: TTemplateChildren read GetChildren; property Items: TList read GetItems; property Gap: integer read FGap write SetGap; property Description: string read GetDescription write SetDescription; property Text: string read GetText; property PersonalOwner: Int64 read FPersonalOwner write SetPersonalOwner; property Expanded: boolean read FExpanded write FExpanded; property Tag: longint read FTag write FTag; property LastTagIndex: longint read FLastTagIndex write FLastTagIndex; property DialogAborted: boolean read GetDialogAborted; property ReminderDialog: string read FReminderDialog write SetReminderDialog; property IsReminderDialog: boolean read FIsReminderDialog write FIsReminderDialog; property IsCOMObject: boolean read FIsCOMObject write FIsCOMObject; property Locked: boolean read FLocked; property COMObject: integer read FCOMObject write SetCOMObject; property COMParam: string read FCOMParam write SetCOMParam; property FileLink: string read FFileLink write SetFileLink; property TemplatePreviewMode: boolean read FPreviewMode write FPreviewMode; end; function SearchMatch(const SubStr, Str: string; const WholeWordsOnly: boolean): boolean; function UserTemplateAccessLevel: TTemplateAccess; function AddTemplate(DataString: string; Owner: TTemplate = nil): TTemplate; procedure LoadTemplateData; procedure ExpandTemplate(tmpl: TTemplate); procedure ReleaseTemplates; procedure RemoveAllNodes; function CanEditLinkType(LinkType: TTemplateLinkTypes): boolean; function GetLinkedTemplate(IEN: string; LType: TTemplateLinkType): TTemplate; function ConvertFileLink(IEN: string; LType: TTemplateLinkType): string; function GetLinkName(IEN: string; LType: TTemplateLinkType): string; function BackupDiffers: boolean; procedure SaveTemplate(Template: TTemplate; Idx: integer; ErrorList: TStrings = nil); function SaveAllTemplates: boolean; procedure ClearBackup; procedure MarkDeleted(Template: TTemplate); function BadTemplateName(Text: string): boolean; procedure WordImportError(msg: string); procedure XMLImportError(Result: HResult); procedure XMLImportCheck(Result: HResult); function GetXMLFromWord(const AFileName: string; Data: TStrings): boolean; function WordImportActive: boolean; procedure UnlockAllTemplates; function DisplayGroupToLinkType(DGroup: integer): TTemplateLinkType; (*procedure ExecuteTemplateOrBoilerPlate(SL: TStrings; IEN: Integer; LType: TTemplateLinkType; OwningForm: TForm; const CaptionText: string = ''; DocInfo: string = ''); overload; procedure ExecuteTemplateOrBoilerPlate(var AText: string; IEN: Integer; LType: TTemplateLinkType; OwningForm: TForm; const CaptionText: string = ''; DocInfo: string = ''); overload;*) procedure ExecuteTemplateOrBoilerPlate(SL: TStrings; IEN: Integer; LType: TTemplateLinkType; OwningForm: TForm; CaptionText: string; var DocInfo: string); overload; procedure ExecuteTemplateOrBoilerPlate(var AText: string; IEN: Integer; LType: TTemplateLinkType; OwningForm: TForm; CaptionText: string; var DocInfo: string); overload; procedure ExpandEmbeddedFields(flds: TStringList); function MakeXMLParamTIU(ANoteID: string; ANoteRec: TEditNoteRec): string; overload; function MakeXMLParamTIU(ADCSummID: string; ADCSummRec: TEditDCSummRec): string; overload; function GetXMLParamReturnValueTIU(DocInfo, ParamTag: string): string; const EmptyNodeText = '<^Empty Node^>'; NewTemplateName = 'New Template'; FirstRealTemplateType = ttMyRoot; LastRealTemplateType = ttGroup; TemplateTypeCodes: array[FirstRealTemplateType..LastRealTemplateType] of string[2] = ('P','R','TF','CF','OF','C','T','G'); BadNameText = CRLF + CRLF + 'Valid Template names must start with an alphanumber '+ 'character, and be at least 3 characters in length.' + CRLF + 'In addition, no template can be named "' + NewTemplateName+'".'; TemplateLockedText = 'Template %s is currently being edited by another user.'; XMLTemplateTag = 'TEMPLATE'; XMLTemplateFieldsTag = 'TEMPLATE_FIELDS'; XMLHeader = 'CPRS_TEMPLATE'; var Templates: TStringList = nil; RootTemplate: TTemplate = nil; MyTemplate: TTemplate = nil; TitlesTemplate: TTemplate = nil; ConsultsTemplate: TTemplate = nil; ProceduresTemplate: TTemplate = nil; implementation uses Windows, rTemplates, uCore, dShared, fTemplateDialog, ActiveX, ComObj, uTemplateFields, XMLUtils, fTemplateImport, Word97, uSpell, rCore, uConst, ORCtrls, uEventHooks, fReminderDialog, rODBase; const MaxSeq = 999999; sLoading = 'Loading Template Information...'; type ETemplateError = class(Exception); ETemplateImportError = class(Exception); ETemplateXMLImportError = class(EOleSysError); var TemplateAccessLevelChecked: boolean = FALSE; TemplateAccessLevelValue: TTemplateAccess; LastTemplateLocation: integer = 0; TempSL: TStringList = nil; Deleted: TStringList = nil; NodeCount: longint = 0; // Used by FNodes to prevent access violations in a Resync GettingDialogText: boolean = FALSE; uIndentLevel: integer; uDlgCount: longint = 0; // Used for dialogs on unsaved templates uUniqueIDNum: longint = 0; // Used for dialogs on unsaved templates uCanEditLinkTypeResults: string = ''; uTemplateDataLoaded: boolean = FALSE; uDGroupConsults: integer = 0; uDGroupProcedures: integer = 0; type TTemplateExportField = (efName, efBlankLines, efType, efStatus, efExclude, efDialog, efDisplayOnly, efFirstLine, efOneItemOnly, efHideDialogItems, efHideTreeItems, efIndentItems, efBoilerplate, efDescription, efItems, efLock); const TemplateActiveCode: array[boolean] of string[1] = ('I','A'); TemplateExportTag: array[TTemplateExportField] of string = // From Field Names in File 8927 { efName } ('NAME', { efBlankLines } 'BLANK_LINES', { efType } 'TYPE', { efStatus } 'STATUS', { efExclude } 'EXCLUDE_FROM_GROUP_BOILERPLATE', { efDialog } 'DIALOG', { efDisplayOnly } 'DISPLAY_ONLY', { efFirstLine } 'FIRST_LINE', { efOneItemOnly } 'ONE_ITEM_ONLY', { efHideDialogItems } 'HIDE_DIALOG_ITEMS', { efHideTreeItems } 'HIDE_TREE_ITEMS', { efIndentItems } 'INDENT_ITEMS', { efBoilerplate } 'BOILERPLATE_TEXT', { efDescription } 'DESCRIPTION', { efItems } 'ITEMS', { efLock } 'LOCK'); ExportPieces:array[TTemplateExportField] of integer = { efName } (4, { efBlankLines } 6, { efType } 2, { efStatus } 3, { efExclude } 5, { efDialog } 9, { efDisplayOnly } 10, { efFirstLine } 11, { efOneItemOnly } 12, { efHideDialogItems } 13, { efHideTreeItems } 14, { efIndentItems } 15, { efBoilerplate } 0, { efDescription } 0, { efItems } 0, { efLock } 18); XMLErrorMessage = 'Error Importing Template. File does not contain Template ' + 'information or may be corrupted.'; WordErrorMessage = 'Error Importing Word Document.'; type TTemplateFieldExportField = (tfName, tfType, tfLength, tfDefault, tfDefIdx, tfDesc, tfItems, tfDateType, tfTextLen, tfMinVal, tfMaxVal); const TemplateFieldExportTag: array[TTemplateFieldExportField] of string = // From Field Names in File 8927.1 { tfName } ('NAME', { tfType } 'TYPE', { tfLength } 'LENGTH', { tfDefault } 'DEFAULT_TEXT', { tfDefIdx } 'DEFAULT_INDEX', { tfDesc } 'DESCRIPTION', { tfItems } 'ITEMS', { tfDateType } 'DATE_TYPE', { tfTextLen } 'MAX_LENGTH', { tfMinVal } 'MIN_VALUE', { tfMaxVal } 'MAX_VALUE'); XMLFieldTag = 'FIELD'; LinkGlobal: array[TTemplateLinkType] of string = { ltNone } ('', { ltTitle } ';TIU(8925.1,', { ltConsult } ';GMR(123.5,', { ltProcedure } ';GMR(123.3,'); LinkPassCode: array[TTemplateLinkType] of string = { ltNone } ('', { ltTitle } 'T', { ltConsult } 'C', { ltProcedure } 'P'); function DlgText(const txt: string; DlgProps: string): string; var i, j: integer; begin Result := txt; if GettingDialogText then begin if (Result = '') then Result := NoTextMarker; i := pos(DlgPropMarker, Result); j := pos(ObjMarker, Result); if(i > 0) and (j > 0) then delete(Result, i, j - i + ObjMarkerLen) else i := length(Result) + 1; insert(DlgPropMarker + DlgProps + ObjMarker, Result, i); end; end; function SearchMatch(const SubStr, Str: string; const WholeWordsOnly: boolean): boolean; const AlphaNumeric = ['A'..'Z','a'..'z','0'..'9']; var i, j: integer; begin i := pos(SubStr,Str); if(i > 0) then begin Result := TRUE; if(WholeWordsOnly) then begin if((i > 1) and (Str[i-1] in AlphaNumeric)) then Result := FALSE else begin j := length(SubStr); if((i+j) <= length(Str)) then Result := (not (Str[i+j] in AlphaNumeric)); end; end; end else Result := FALSE; end; function UserTemplateAccessLevel: TTemplateAccess; var i: integer; begin if(TemplateAccessLevelChecked and (LastTemplateLocation = Encounter.Location)) then Result := TemplateAccessLevelValue else begin TemplateAccessLevelChecked := FALSE; LastTemplateLocation := 0; if(not assigned(RootTemplate)) then begin Result := taAll; GetTemplateRoots; for i := 0 to RPCBrokerV.Results.Count-1 do begin if(Piece(RPCBrokerV.Results[i],U,2)=TemplateTypeCodes[ttRoot]) then begin Result := TTemplateAccess(GetTemplateAccess(Piece(RPCBrokerV.Results[i],U,1))); LastTemplateLocation := Encounter.Location; TemplateAccessLevelChecked := TRUE; TemplateAccessLevelValue := Result; Break; end; end; end else begin Result := TTemplateAccess(GetTemplateAccess(RootTemplate.ID)); LastTemplateLocation := Encounter.Location; TemplateAccessLevelChecked := TRUE; TemplateAccessLevelValue := Result; end; end; end; function AddTemplate(DataString: string; Owner: TTemplate = nil): TTemplate; var idx: integer; id: string; tmpl: TTemplate; begin id := Piece(DataString, U, 1); if(id = '') or (id = '0') then idx := -1 else idx := Templates.IndexOf(id); if(idx < 0) then begin tmpl := TTemplate.Create(DataString); Templates.AddObject(id, tmpl); if(tmpl.Active) then begin if (tmpl.RealType = ttRoot) then RootTemplate := tmpl else if (tmpl.RealType = ttTitles) then TitlesTemplate := tmpl else if (tmpl.RealType = ttConsults) then ConsultsTemplate := tmpl else if (tmpl.RealType = ttProcedures) then ProceduresTemplate := tmpl else if(tmpl.RealType = ttMyRoot) then MyTemplate := tmpl; end; end else tmpl := TTemplate(Templates.Objects[idx]); if(assigned(Owner)) and (assigned(tmpl)) then Owner.AddChild(tmpl); Result := tmpl; end; procedure LoadTemplateData; var i: integer; TmpSL: TStringList; begin if(not uTemplateDataLoaded) then begin StatusText(sLoading); try if(not assigned(Templates)) then Templates := TStringList.Create; TmpSL := TStringList.Create; try GetTemplateRoots; TmpSL.Assign(RPCBrokerV.Results); for i := 0 to TmpSL.Count-1 do AddTemplate(TmpSL[i]); uTemplateDataLoaded := TRUE; finally TmpSL.Free; end; finally StatusText(''); end; end; end; procedure ExpandTemplate(tmpl: TTemplate); var i: integer; TmpSL: TStringList; begin if(not tmpl.Expanded) then begin if(tmpl.Children <> tcNone) then begin StatusText(sLoading); try TmpSL := TStringList.Create; try GetTemplateChildren(tmpl.FID); TmpSL.Assign(RPCBrokerV.Results); for i := 0 to TmpSL.Count-1 do AddTemplate(TmpSL[i], tmpl); finally TmpSL.Free; end; finally StatusText(''); end; end; tmpl.Expanded := TRUE; with tmpl,tmpl.FBkup do begin BItemIENs := ItemIENs; SavedItemIENs := TRUE; end; end; end; procedure ReleaseTemplates; var i: integer; begin if(assigned(Templates)) then begin for i := 0 to Templates.Count-1 do TTemplate(Templates.Objects[i]).Free; Templates.Free; Templates := nil; uTemplateDataLoaded := FALSE; end; ClearBackup; if(assigned(TempSL)) then begin TempSL.Free; TempSL := nil; end; if(assigned(Deleted)) then begin Deleted.Clear; Deleted := nil; end; RootTemplate := nil; MyTemplate := nil; TitlesTemplate := nil; ConsultsTemplate := nil; ProceduresTemplate := nil; end; procedure RemoveAllNodes; var i: integer; begin if(assigned(Templates)) then begin for i := 0 to Templates.Count-1 do TTemplate(Templates.Objects[i]).FNodes.Clear; end; end; function CanEditLinkType(LinkType: TTemplateLinkTypes): boolean; function CanEditType(Template: TTemplate): boolean; begin if not assigned(Template) then Result := FALSE else if pos(Char(ord(LinkType)+ord('0')), uCanEditLinkTypeResults) > 0 then Result := (pos(Char(ord(LinkType)+ord('A')), uCanEditLinkTypeResults) > 0) else begin Result := IsUserTemplateEditor(Template.ID, User.DUZ); uCanEditLinkTypeResults := uCanEditLinkTypeResults + Char(ord(LinkType)+ord('0')); if Result then uCanEditLinkTypeResults := uCanEditLinkTypeResults + Char(ord(LinkType)+ord('A')); end; end; begin case LinkType of ttTitles: Result := CanEditType(TitlesTemplate); ttConsults: Result := CanEditType(ConsultsTemplate); ttProcedures: Result := CanEditType(ProceduresTemplate); else Result := FALSE; end; end; function GetLinkedTemplate(IEN: string; LType: TTemplateLinkType): TTemplate; var idx: integer; Data, ALink: string; begin Result := nil; if LType <> ltNone then begin if(not assigned(Templates)) then Templates := TStringList.Create; ALink := IEN + LinkGlobal[LType]; for idx := 0 to Templates.Count-1 do begin if ALink = TTemplate(Templates.Objects[idx]).FFileLink then begin Result := TTemplate(Templates.Objects[idx]); break; end; end; if not assigned(Result) then begin Data := GetLinkedTemplateData(ALink); if Data <> '' then Result := AddTemplate(Data); end; end; end; function ConvertFileLink(IEN: string; LType: TTemplateLinkType): string; begin if(LType = ltNone) or (IEN = '') or (StrToIntDef(IEN,0) = 0) then Result := '' else Result := IEN + LinkGlobal[LType]; end; function GetLinkName(IEN: string; LType: TTemplateLinkType): string; var IEN64: Int64; begin IEN64 := StrToInt64Def(IEN,0); case LType of ltTitle: Result := ExternalName(IEN64,8925.1); ltConsult: Result := ExternalName(IEN64,123.5); ltProcedure: Result := ExternalName(IEN64,123.3); else Result := ''; end; end; function BackupDiffers: boolean; var i: integer; begin Result := FALSE; if(assigned(Templates)) then begin for i := 0 to Templates.Count-1 do begin if(TTemplate(Templates.Objects[i]).Changed) then begin Result := TRUE; exit; end; end; end; end; procedure DisplayErrors(Errors: TStringList; SingleError: string = ''); begin if(assigned(Errors)) then ShowMessage(Errors.text) else ShowMessage(SingleError); end; procedure SaveTemplate(Template: TTemplate; Idx: integer; ErrorList: TStrings = nil); var i: integer; ID, Tmp: string; NoCheck: boolean; DescSL: TStringList; begin { Removed because this may be a bug??? - what if it's hidden? - better to save and delete than miss it //Don't save new templates that have been deleted if(((Template.ID = '0') or (Template.ID = '')) and (Template.Nodes.Count = 0)) then exit; } if(not Template.Changed) then begin Template.Unlock; exit; end; if(not assigned(TempSL)) then TempSL := TStringList.Create; TempSL.Clear; ID := Template.ID; NoCheck := (ID = '0') or (ID = ''); with Template,Template.FBkup do begin if(NoCheck or (SavedBoilerplate and (BBoilerplate <> Boilerplate))) then begin TempSL.Text := BoilerPlate; if(TempSL.Count > 0) then begin for i := 0 to TempSL.Count-1 do TempSL[i] := '2,'+IntToStr(i+1)+',0='+TempSL[i]; end else TempSL.Add('2,1=@'); end; if(NoCheck or (SavedPrintName and (BPrintName <> PrintName))) then TempSL.Add('.01='+PrintName); if(NoCheck or (SavedGap and (BGap <> Gap))) then begin if Gap = 0 then TempSL.Add('.02=@') else TempSL.Add('.02='+IntToStr(Gap)); end; if(NoCheck or (SavedRealType and (BRealType <> RealType))) then TempSL.Add('.03='+TemplateTypeCodes[RealType]); if(NoCheck or (SavedActive and (BActive <> Active))) then TempSL.Add('.04='+TemplateActiveCode[Active]); if(NoCheck or (SavedExclude and (BExclude <> FExclude))) then TempSL.Add('.05='+BOOLCHAR[Exclude]); if(NoCheck or (SavedDialog and (BDialog <> FDialog))) then TempSL.Add('.08='+BOOLCHAR[Dialog]); if(NoCheck or (SavedDisplayOnly and (BDisplayOnly <> DisplayOnly))) then TempSL.Add('.09='+BOOLCHAR[DisplayOnly]); if(NoCheck or (SavedFirstLine and (BFirstLine <> FirstLine))) then TempSL.Add('.1='+BOOLCHAR[FirstLine]); if(NoCheck or (SavedOneItemOnly and (BOneItemOnly <> OneItemOnly))) then TempSL.Add('.11='+BOOLCHAR[OneItemOnly]); if(NoCheck or (SavedHideDlgItems and (BHideDlgItems <> HideDlgItems))) then TempSL.Add('.12='+BOOLCHAR[HideDlgItems]); if(NoCheck or (SavedHideItems and (BHideItems <> HideItems))) then TempSL.Add('.13='+BOOLCHAR[HideItems]); if(NoCheck or (SavedIndentItems and (BIndentItems <> IndentItems))) then TempSL.Add('.14='+BOOLCHAR[IndentItems]); if(NoCheck or (SavedReminderDialog and (BReminderDialog <> ReminderDialog))) then begin if ReminderDialogIEN = '' then TempSL.Add('.15=@') else TempSL.Add('.15='+ReminderDialogIEN); end; if(NoCheck or (SavedLock and (BLock <> Lock))) then TempSL.Add('.16='+BOOLCHAR[Lock]); if(NoCheck or (SavedCOMObject and (BCOMObject <> COMObject))) then begin if COMObject = 0 then TempSL.Add('.17=@') else TempSL.Add('.17='+IntToStr(COMObject)); end; if(NoCheck or (SavedCOMParam and (BCOMParam <> COMParam))) then begin if COMParam = '' then TempSL.Add('.18=@') else TempSL.Add('.18=' + COMParam); end; if(NoCheck or (SavedFileLink and (BFileLink <> FileLink))) then begin if FileLink = '' then TempSL.Add('.19=@') else TempSL.Add('.19=' + FileLink); end; if(NoCheck or (SavedPersonalOwner and (BPersonalOwner <> PersonalOwner))) then begin if(PersonalOwner = 0) then Tmp := '' else Tmp := IntToStr(PersonalOwner); TempSL.Add('.06='+Tmp); end; if(NoCheck or (SavedDescription and (BDescription <> Description))) then begin DescSL := TStringList.Create; try DescSL.Text := Description; if(DescSL.Count > 0) then begin for i := 0 to DescSL.Count-1 do DescSL[i] := '5,'+IntToStr(i+1)+',0='+DescSL[i]; end else DescSL.Add('5,1=@'); TempSL.AddStrings(DescSL) finally DescSL.Free; end; end; end; if(TempSL.Count > 0) then begin Tmp := UpdateTemplate(ID, TempSL); if(Piece(Tmp,U,1) = '0') then begin Tmp := 'Error Saving ' + Template.PrintName + ' ' + ID + '=' + Tmp; if(Assigned(ErrorList)) then ErrorList.Add(Tmp) else DisplayErrors(nil, Tmp); end else begin if(((ID = '') or (ID = '0')) and (Tmp <> ID)) then begin if(idx < 0) then idx := Templates.IndexOfObject(Template); Template.FID := Tmp; Templates[idx] := Tmp; if assigned(Template.FNodes) then begin for i := 0 to Template.FNodes.Count-1 do TORTreeNode(Template.FNodes.Objects[i]).StringData := Template.ID + U + Template.PrintName; end; end; Template.ClearBackup(FALSE); if NoCheck then with Template.FBkup do begin BItemIENs := ''; SavedItemIENs := TRUE; end; end; end; end; function SaveAllTemplates: boolean; var i, k: integer; New: TTemplate; Errors: TStringList; First, ChildErr: boolean; begin Errors := TStringList.Create; try if(assigned(Templates)) then begin if(not assigned(TempSL)) then TempSL := TStringList.Create; for i := 0 to Templates.Count-1 do SaveTemplate(TTemplate(Templates.Objects[i]), i, Errors); First := TRUE; if(Errors.Count > 0) then Errors.Insert(0,'Errors Encountered Saving Templates:'); for i := 0 to Templates.Count-1 do begin New := TTemplate(Templates.Objects[i]); with New.FBkup do if(SavedItemIENs and (BItemIENs <> New.ItemIENs)) then begin TempSL.Clear; for k := 0 to New.Items.Count-1 do TempSL.Add(TTemplate(New.Items[k]).FID); UpdateChildren(New.ID, TempSL); ChildErr := FALSE; for k := 0 to RPCBrokerV.Results.Count-1 do begin if(RPCBrokerV.Results[k] <> IntToStr(k+1)) then begin if(First) then begin Errors.Add('Errors Encountered Saving Children:'); First := FALSE; end; Errors.Add(New.ID+' Item #'+IntToStr(k+1)+'('+ TTemplate(New.Items[k]).FID+')'+'='+RPCBrokerV.Results[k]); ChildErr := TRUE; end; end; if(not ChildErr) then BItemIENs := New.ItemIENs; end; New.Unlock; end; if(assigned(Deleted)) and (Deleted.Count > 0) then begin DeleteTemplates(Deleted); Deleted.Clear; end; if(Errors.Count > 0) then DisplayErrors(Errors); end; finally Result := (Errors.Count = 0); Errors.Free; end; end; procedure ClearBackup; var i: integer; begin if(assigned(Templates)) then begin for i := 0 to Templates.Count-1 do TTemplate(Templates.Objects[i]).ClearBackup; end; end; procedure MarkDeleted(Template: TTemplate); var i, idx: integer; begin if(Template.ValidID) then begin if(not assigned(Deleted)) then Deleted := TStringList.Create; idx := Deleted.IndexOf(Template.ID); if(idx < 0) then Deleted.Add(Template.ID); end; Template.FileLink := ''; Template.GetItems; for i := 0 to Template.FItems.Count-1 do MarkDeleted(TTemplate(Template.FItems[i])); end; function BadTemplateName(Text: string): boolean; begin Result := FALSE; if(Text = NewTemplateName) or (length(Text) < 3) then Result := TRUE else if(not (Text[1] in ['a'..'z','A'..'Z','0'..'9'])) then Result := TRUE; end; procedure WordImportError(msg: string); begin raise ETemplateImportError.Create(WordErrorMessage + CRLF + msg); end; procedure XMLImportError(Result: HResult); begin raise ETemplateXMLImportError.Create(XMLErrorMessage, Result, 0); end; procedure XMLImportCheck(Result: HResult); begin if not Succeeded(Result) then XMLImportError(Result); end; procedure AddXMLData(Data: TStrings; const Pad: string; FldType: TTemplateExportField; const Value, DefValue: string); begin if(Value <> '') and (Value <> DefValue) then Data.Add(Pad + ' <' + TemplateExportTag[FldType] + '>' + Text2XML(Value) + ''); end; procedure AddXMLBool(Data: TStrings; const Pad: string; FldType: TTemplateExportField; const Value: boolean); begin AddXMLData(Data, Pad, FldType, BOOLCHAR[Value], BOOLCHAR[FALSE]); end; procedure AddXMLList(Data, Fields: TStrings; const Pad: string; FldType: TTemplateExportField; Const Txt: string); var i: integer; TmpSL: TStrings; begin if(Txt <> '') then begin TmpSL := TStringList.Create; try TmpSL.Text := Txt; Data.Add(Pad + ' <' + TemplateExportTag[FldType] + '>'); for i := 0 to TmpSL.Count-1 do Data.Add(Pad + '

' + Text2XML(TmpSL[i]) + '

'); Data.Add(Pad + ' '); finally TmpSL.Free; end; if assigned(Fields) then ListTemplateFields(Txt, Fields); end; end; function GetXMLFromWord(const AFileName: string; Data: TStrings): boolean; var itmp, itmp2, itmp3, i, j: integer; WDoc: TWordDocument; WasVis: boolean; WApp: TWordApplication; Boiler: string; FldCache, Fields, PendingAdd: TStringList; OldCur: TCursor; idx, TmpVar, RangeStart, RangeEnd: oleVariant; ddTotal, ffTotal, ffStartCur, ffEndCur, ffEndLast : integer; ffRange, textRange: Range; tmp, TemplateName, fName: string; tmpType, tfIdx: TTemplateFieldType; tmpDate: TTmplFldDateType; tfCount: array[TTemplateFieldType] of integer; procedure AddBoiler(txt: string); var i: integer; c: char; tmp: string; begin tmp := ''; for i := 1 to length(txt) do begin c := txt[i]; if (c > #31) or (c = #13) or (c = #10) then tmp := tmp + c; end; Boiler := Boiler + tmp; end; procedure AddField(Typ: TTemplateFieldExportField; Value: string; Pending: boolean = FALSE); var sl: TStringList; begin if Pending then sl := PendingAdd else sl := Fields; sl.Add('<' + TemplateFieldExportTag[Typ] + '>' + Text2XML(Value) + ''); end; procedure AddFieldHeader(FldType: TTemplateFieldType; First: boolean); var tmp: string; begin tmp := '<'; if not First then tmp := tmp + '/'; tmp := tmp + XMLFieldTag; if First then begin fname := 'WORDFLD_' + FldNames[FldType] + '_'; tfIdx := FldType; tmp := tmp + ' ' + TemplateFieldExportTag[tfName] + '="' + Text2XML(fname); end; if not First then tmp := tmp + '>'; Fields.Add(tmp); if First then AddField(tfType, TemplateFieldTypeCodes[FldType]); end; procedure WordWrap(var Str: string); var TmpSL: TStringList; i: integer; begin TmpSL := TStringList.Create; try TmpSL.Text := Str; Str := ''; for i := 0 to TmpSL.Count-1 do begin if Str <> '' then Str := Str + CRLF; Str := Str + WrapText(TmpSL[i], #13#10, [' ','-'], MAX_ENTRY_WIDTH); end; finally TmpSL.Free; end; end; begin for tfIdx := low(TTemplateFieldType) to high(TTemplateFieldType) do tfCount[tfIdx] := 1; TemplateName := ExtractFileName(AFileName); Result := TRUE; try OldCur := Screen.Cursor; Screen.Cursor := crAppStart; try WApp := TWordApplication.Create(nil); try WasVis := WApp.Visible; WApp.Visible := FALSE; try WDoc := TWordDocument.Create(nil); try try WApp.Connect; TmpVar := AFileName; WDoc.ConnectTo(WApp.Documents.Add(TmpVar, EmptyParam)); ffTotal := WDoc.FormFields.Count; if ffTotal > 3 then StartImportMessage(TemplateName, ffTotal+1); if WDoc.ProtectionType <> wdNoProtection then WDoc.Unprotect; Data.Add('<'+XMLHeader+'>'); tmp := ExtractFileExt(TemplateName); if tmp <> '' then begin i := pos(tmp,TemplateName); if i > 0 then delete(TemplateName, i, length(tmp)); end; TemplateName := copy(TemplateName, 1, 60); if BadTemplateName(TemplateName) then begin tmp := copy('WordDoc ' + TemplateName, 1, 60); if BadTemplateName(TemplateName) then tmp := 'Imported Word Document' else tmp := TemplateName; end else tmp := TemplateName; Data.Add('<' + XMLTemplateTag + ' ' + TemplateExportTag[efName] + '="' + Text2XML(tmp) + '">'); AddXMLData(Data, '', efType, TemplateTypeCodes[ttDoc], ''); AddXMLData(Data, '', efStatus, TemplateActiveCode[TRUE], ''); Boiler := ''; Fields := TStringList.Create; try FldCache := TStringList.Create; try PendingAdd := TStringList.Create; try ffEndCur := 0; for i := 1 to ffTotal do begin if UpdateImportMessage(i) then begin Result := FALSE; Data.Clear; break; end; idx := i; ffEndLast := ffEndCur; ffRange := WDoc.FormFields.Item(idx).Range; ffStartCur := ffRange.Start; ffEndCur := ffRange.End_; // Assign working start range for text collection: if i = 1 then rangeStart := 0 // Before first FormField, use start of document. else rangeStart := ffEndLast; // Start of new range is end of the last FormField range. // Assign working end range for text collection: rangeEnd := ffStartCur; // End of new range is start of current FormField range. // Collect text in the range: textRange := WDoc.Range(rangeStart, rangeEnd); textRange.Select; AddBoiler(TextRange.text); tfIdx := dftUnknown; fname := ''; case WDoc.FormFields.Item(idx).type_ of wdFieldFormTextInput: begin itmp3 := WDoc.FormFields.Item(idx).TextInput.Type_; case itmp3 of wdNumberText: tmpType := dftNumber; wdDateText, wdCurrentDateText, wdCurrentTimeText: tmpType := dftDate; else tmpType := dftEditBox; end; AddFieldHeader(tmpType, TRUE); tmpDate := dtUnknown; tmp := WDoc.FormFields.Item(idx).TextInput.Default; case itmp3 of wdNumberText: begin AddField(tfMinVal, IntToStr(-9999), TRUE); AddField(tfMaxVal, IntToStr(9999), TRUE); end; wdDateText: tmpDate := dtDate; wdCurrentDateText: begin tmpDate := dtDate; if tmp = '' then tmp := 'T'; end; wdCurrentTimeText: begin tmpDate := dtDateTime; if tmp = '' then tmp := 'NOW'; end; else begin itmp2 := WDoc.FormFields.Item(idx).TextInput.Width; itmp := itmp2; if (itmp < 1) then begin itmp := length(tmp); if itmp < 10 then itmp := 10 else if itmp > 70 then itmp := 70; itmp2 := 240; end else begin if (itmp > 70) then itmp := 70; if (itmp2 > 240) then itmp2 := 240; end; AddField(tfLength, IntToStr(itmp)); AddField(tfTextLen, IntToStr(itmp2), TRUE); end; end; if tmpDate <> dtUnknown then AddField(tfDateType, TemplateFieldDateCodes[tmpDate], TRUE); if tmp <> '' then AddField(tfDefault, tmp); Fields.AddStrings(PendingAdd); PendingAdd.Clear; AddFieldHeader(tmpType, FALSE); end; wdFieldFormCheckBox: begin AddFieldHeader(dftButton, TRUE); itmp := ord(boolean(WDoc.FormFields.Item(idx).CheckBox.Default))+1; AddField(tfDefIdx, IntToStr(itmp)); Fields.Add('<' + TemplateFieldExportTag[tfItems] + '>'); Fields.Add('

' + Text2XML('[ ]') + '

'); Fields.Add('

' + Text2XML('[X]') + '

'); Fields.Add(''); AddFieldHeader(dftButton, FALSE); end; wdFieldFormDropDown: begin ddTotal := WDoc.FormFields.Item(Idx).DropDown.ListEntries.Count; if(ddTotal > 0)then begin AddFieldHeader(dftComboBox, TRUE); itmp := WDoc.FormFields.Item(idx).DropDown.Default; if itmp > 0 then AddField(tfDefIdx, IntToStr(itmp)); Fields.Add('<' + TemplateFieldExportTag[tfItems] + '>'); for j := 1 to ddTotal do begin TmpVar := j; tmp := WDoc.FormFields.Item(Idx).DropDown.ListEntries.Item(TmpVar).Name; Fields.Add('

' + Text2XML(tmp) + '

'); end; Fields.Add(''); AddFieldHeader(dftComboBox, FALSE); end; end; end; if (Fields.Count > 0) then begin if tfIdx <> dftUnknown then begin tmp := Fields.CommaText; j := FldCache.IndexOf(tmp); if j < 0 then begin FldCache.AddObject(tmp, TObject(tfCount[tfIdx])); j := tfCount[tfIdx]; inc(tfCount[tfIdx]); end else j := Integer(FldCache.Objects[j]); Boiler := Boiler + TemplateFieldBeginSignature + fname + IntToStr(j) + TemplateFieldEndSignature; end; Fields.Clear; end; end; if Result then begin rangeStart := ffEndCur; // Start of new range is end of last FormField range. rangeEnd := WDoc.Range.End_; // After last FormField, use end of document. // Collect text in trailing range: textRange := WDoc.Range(rangeStart, rangeEnd); textRange.Select; AddBoiler(TextRange.text); WordWrap(Boiler); AddXMLList(Data, nil, '', efBoilerplate, Boiler); tmp := WrapText('Imported on ' + FormatFMDateTime('mmm dd yyyy hh:nn', FMNow) + ' from Word Document: ' + AFileName, #13#10, [' '], MAX_ENTRY_WIDTH); AddXMLList(Data, nil, '', efDescription, tmp); Data.Add(''); if FldCache.Count > 0 then begin Data.Add('<' + XMLTemplateFieldsTag + '>'); for i := 0 to FldCache.Count-1 do begin Fields.Clear; Fields.CommaText := FldCache[i]; if Fields.Count > 0 then begin Fields[0] := Fields[0] + IntToStr(Integer(FldCache.Objects[i])) + '">'; Data.AddStrings(Fields); end; end; Data.Add(''); end; Data.Add(''); UpdateImportMessage(ffTotal+1); end; finally PendingAdd.Free; end; finally FldCache.Free; end; finally Fields.Free; end; except on E:Exception do WordImportError(E.Message); end; finally TmpVar := wdDoNotSaveChanges; WDoc.Close(TmpVar); WDoc.Free; end; finally WApp.Visible := WasVis; end; finally WApp.Disconnect; WApp.Free; end; finally Screen.Cursor := OldCur; end; finally StopImportMessage; end; if not Result then InfoBox('Importing Word Document Canceled.','Import Canceled', MB_OK); end; function WordImportActive: boolean; begin Result := True; //Result := SpellCheckAvailable; spell check disabled in v19.16 end; procedure UnlockAllTemplates; var i: integer; begin if(assigned(Templates)) then begin for i := 0 to Templates.Count-1 do TTemplate(Templates.Objects[i]).Unlock; end; end; function DisplayGroupToLinkType(DGroup: integer): TTemplateLinkType; begin Result := ltNone; if DGroup <> 0 then begin if uDGroupConsults = 0 then uDGroupConsults := DisplayGroupByName('CONSULTS'); if uDGroupProcedures = 0 then uDGroupProcedures := DisplayGroupByName('PROCEDURES'); if DGroup = uDGroupConsults then Result := ltConsult else if DGroup = uDGroupProcedures then Result := ltProcedure; end; end; (*procedure ExecuteTemplateOrBoilerPlate(SL: TStrings; IEN: Integer; LType: TTemplateLinkType; OwningForm: TForm; const CaptionText: string = ''; DocInfo: string = '');*) procedure ExecuteTemplateOrBoilerPlate(SL: TStrings; IEN: Integer; LType: TTemplateLinkType; OwningForm: TForm; CaptionText: string; var DocInfo: string); var Template: TTemplate; txt: string; begin Template := GetLinkedTemplate(IntToStr(IEN), LType); if assigned(Template) then begin if Template.IsReminderDialog then begin Template.ExecuteReminderDialog(OwningForm); DocInfo := ''; end else begin if Template.IsCOMObject then txt := Template.COMObjectText(SL.Text, DocInfo) else begin txt := Template.Text; DocInfo := ''; end; if(txt <> '') then begin CheckBoilerplate4Fields(txt, CaptionText); SL.Text := txt; end; end; end else begin txt := SL.Text; CheckBoilerplate4Fields(txt, CaptionText); DocInfo := ''; SL.Text := txt; end; end; (*procedure ExecuteTemplateOrBoilerPlate(var AText: string; IEN: Integer; LType: TTemplateLinkType; OwningForm: TForm; const CaptionText: string = ''; DocInfo: string = '');*) procedure ExecuteTemplateOrBoilerPlate(var AText: string; IEN: Integer; LType: TTemplateLinkType; OwningForm: TForm; CaptionText: string; var DocInfo: string); var tmp: TStringList; begin tmp := TStringList.Create; try tmp.text := AText; ExecuteTemplateOrBoilerPlate(tmp, IEN, LType, OwningForm, CaptionText, DocInfo); AText := tmp.text; finally tmp.free; end; end; { TTemplate } constructor TTemplate.Create(DataString: string); var i: TTemplateType; Code: string[2]; begin FCloning := TRUE; try FNodes := TStringList.Create; FID := Piece(DataString, U, 1); Code := Piece(DataString, U, 2); FRealType := ttNone; for i := FirstRealTemplateType to LastRealTemplateType do begin if(TemplateTypeCodes[i] = Code) then begin FRealType := i; break; end; end; if FRealType = ttNone then raise ETemplateError.Create('Template has invalid Type Code of "' + Code + '"'); FActive := (Piece(DataString, U, 3) = TemplateActiveCode[TRUE]); FPrintName := Piece(DataString, U, 4); FExclude := (Piece(DataString, U, 5) = '1'); FDialog := (Piece(DataString, U, 9) = '1'); FDisplayOnly := (Piece(DataString, U, 10) = '1'); FFirstLine := (Piece(DataString, U, 11) = '1'); FOneItemOnly := (Piece(DataString, U, 12) = '1'); FHideDlgItems := (Piece(DataString, U, 13) = '1'); FHideItems := (Piece(DataString, U, 14) = '1'); FIndentItems := (Piece(DataString, U, 15) = '1'); FLock := (Piece(DataString, U, 18) = '1'); FReminderDialog := Pieces(DataString, U, 16, 17); FReminderDialog := FReminderDialog + U + Piece(DataString, U, 25); //AGP CHANGE 24.8 FIsReminderDialog := (ReminderDialogIEN <> ''); FCOMObject := StrToIntDef(Piece(DataString, U, 19), 0); FCOMParam := Piece(DataString, U, 20); FFileLink := Piece(DataString, U, 21); FIsCOMObject := (FCOMObject > 0); FGap := StrToIntDef(Piece(DataString, U, 6),0); FPersonalOwner := StrToInt64Def(Piece(DataString, U, 7),0); case StrToIntDef(Piece(DataString, U, 8),0) of 1: FChildren := tcActive; 2: FChildren := tcInactive; 3: FChildren := tcBoth; else FChildren := tcNone; end; FLocked := FALSE; finally FCloning := FALSE; end; end; class function TTemplate.CreateFromXML(Element: IXMLDOMNode; Owner: string): TTemplate; var DataStr: string; Children, Items: IXMLDOMNodeList; Child, Item: IXMLDOMNode; i, j, count, ItemCount: integer; fld: TTemplateExportField; ETag: string; begin DataStr := '0'; SetPiece(DataStr, U, 4, FindXMLAttributeValue(Element, TemplateExportTag[efName])); SetPiece(DataStr, U, 7, Owner); Children := Element.Get_childNodes; try if assigned(Children) then begin count := Children.Length; for i := 0 to Count - 1 do begin Child := Children.Item[i]; ETag := Child.NodeName; for fld := low(TTemplateExportField) to high(TTemplateExportField) do begin if(ExportPieces[fld] > 0) and (CompareText(ETag, TemplateExportTag[fld]) = 0) then SetPiece(DataStr, U, ExportPieces[fld], Child.Get_Text); end; end; end else Count := 0; Result := Create(DataStr); Result.FCloning := TRUE; try if assigned(Children) then begin for i := 0 to Count - 1 do begin Child := Children.Item[i]; ETag := Child.NodeName; for fld := low(TTemplateExportField) to high(TTemplateExportField) do begin if(ExportPieces[fld] = 0) and (CompareText(ETag, TemplateExportTag[fld]) = 0) then begin case fld of efBoilerplate: Result.SetBoilerplate(GetXMLWPText(Child)); efDescription: Result.SetDescription(GetXMLWPText(Child)); efItems: begin Result.GetItems; Items := Child.Get_childNodes; if assigned(Items) then begin ItemCount := Items.Length; for j := 0 to ItemCount - 1 do begin Item := Items.Item[j]; if(CompareText(Item.NodeName, XMLTemplateTag) = 0) then Result.FItems.Add(CreateFromXML(Item, Owner)); end; end; end; end; end; end; end; end; finally Result.FCloning := FALSE; end; finally Children := nil; end; Result.BackupItems; Templates.AddObject(Result.ID, Result); end; destructor TTemplate.Destroy; begin Unlock; FNodes.Free; if(assigned(FItems)) then FItems.Free; inherited; end; procedure TTemplate.AddChild(Child: TTemplate); begin GetItems; if(FItems.IndexOf(Child) < 0) then FItems.Add(Child); end; procedure TTemplate.RemoveChild(Child: TTemplate); var idx: integer; begin GetItems; idx := FItems.IndexOf(Child); if(idx >= 0) and CanModify then FItems.delete(idx); end; function TTemplate.GetItems: TList; begin if(not assigned(FItems)) then begin FItems := TList.Create; FCreatingChildren := TRUE; try ExpandTemplate(Self); finally FCreatingChildren := FALSE; end; end; Result := FItems; end; function TTemplate.GetTemplateType: TTemplateType; begin Result := FRealType; if(Result in [ttDoc, ttGroup]) and (FExclude) then begin case (Result) of ttDoc: Result := ttDocEx; ttGroup: Result := ttGroupEx; end; end; end; function TTemplate.GetChildren: TTemplateChildren; var i: integer; begin if((assigned(FItems)) and (not FCreatingChildren)) then begin Result := tcNone; for i := 0 to FItems.Count-1 do begin if(TTemplate(FItems[i]).Active) then Result := TTemplateChildren(ord(Result) or ord(tcActive)) else Result := TTemplateChildren(ord(Result) or ord(tcInactive)); if(Result = tcBoth) then break; end; end else Result := FChildren; end; procedure TTemplate.SetTemplateType(const Value: TTemplateType); begin if(GetTemplateType <> Value) and CanModify then begin if(Value in AllTemplateTrueTypes) then SetRealType(Value) else begin case Value of ttDoc: begin SetExclude(FALSE); SetRealType(ttDoc); end; ttGroup: begin SetExclude(FALSE); SetRealType(ttGroup); end; ttDocEx: begin SetExclude(TRUE); SetRealType(ttDoc); end; ttGroupEx: begin SetExclude(TRUE); SetRealType(ttGroup); end; end; end; end; end; function TTemplate.GetBoilerplate: string; begin Result := ''; if FIsReminderDialog or FIsCOMObject then exit; if(RealType in [ttDoc, ttGroup]) then begin if(not FBoilerPlateLoaded) then begin StatusText('Loading Template Boilerplate...'); try GetTemplateBoilerplate(FID); FBoilerplate := RPCBrokerV.Results.Text; FBoilerPlateLoaded := TRUE; finally StatusText(''); end; end; Result := FBoilerplate; end; end; { Returns the cumulative boilerplate of a groups items } function TTemplate.ItemBoilerplate: string; var i, j: integer; Template: TTemplate; GapStr: string; begin Result := ''; if FIsReminderDialog or FIsCOMObject then exit; if(RealType = ttGroup) then begin GetItems; GapStr := ''; if(FGap > 0) then begin for j := 1 to FGap do GapStr := GapStr + CRLF; end; if(IndentItems) then inc(uIndentLevel); try for i := 0 to FItems.Count-1 do begin Template := TTemplate(FItems[i]); if(Template.Active and (Template.TemplateType in [ttDoc, ttGroup])) then begin if i > 0 then Result := Result + GapStr; Result := Result + DlgText(TTemplate(FItems[i]).FullBoilerplate, TTemplate(FItems[i]).DialogProperties(Self)); end; end; finally if(IndentItems) then dec(uIndentLevel); end; end; end; {returns the complete boilerplate, including a group's items } function TTemplate.FullBoilerplate: string; var Itm: string; begin Result := GetBoilerplate; if FIsReminderDialog or FIsCOMObject then exit; Itm := ItemBoilerplate; if(Result <> '') and (Itm <> '') and (copy(Result,length(Result)-1,2) <> CRLF) then Result := Result + CRLF; Result := DlgText(Result, DialogProperties) + Itm; end; {Sets the items boilerplate - does not affect children boilerplates of a group } procedure TTemplate.SetBoilerplate(Value: string); begin if(FBoilerplate <> Value) and CanModify then begin with FBkup do begin if(FBoilerPlateLoaded and (not SavedBoilerplate) and ValidID) then begin BBoilerplate := FBoilerplate; SavedBoilerplate := TRUE; end; end; FBoilerplate := Value; end; FBoilerPlateLoaded := TRUE; end; {Gets the object-expanded boilerplated text} function TTemplate.GetText: string; var OldGettingDialogText: boolean; TmpSL: TStringList; begin Result := ''; if FIsReminderDialog or FIsCOMObject then exit; TmpSL := TStringList.Create; try StatusText('Expanding Boilerplate Text...'); try OldGettingDialogText := GettingDialogText; if(IsDialog) then begin GettingDialogText := TRUE; inc(uDlgCount); if not OldGettingDialogText then uIndentLevel := 0; end; try TmpSL.Text := FullBoilerPlate; finally if(IsDialog) then GettingDialogText := OldGettingDialogText; end; GetTemplateText(TmpSL); if(IsDialog) then FDialogAborted := DoTemplateDialog(TmpSL, 'Template: ' + FPrintName, TemplatePreviewMode); Result := TmpSL.Text; finally StatusText(''); end; finally TmpSL.Free; end; end; procedure TTemplate.SetPersonalOwner(Value: Int64); var i: integer; ok: boolean; begin if(FPersonalOwner <> Value) then begin ok := CanModify; if ok then begin with FBkup do begin if(not SavedPersonalOwner) and ValidID then begin BPersonalOwner := FPersonalOwner; SavedPersonalOwner := TRUE; end; end; FPersonalOwner := Value; end; end else ok := TRUE; if ok and (Value = 0) then // No Shared Template can have personal items within it. begin GetItems; for i := 0 to FItems.Count-1 do TTemplate(FItems[i]).SetPersonalOwner(0); end; end; procedure TTemplate.AddNode(Node: Pointer); begin if(dmodShared.InEditor) and (FNodes.IndexOfObject(Node) < 0) then begin inc(NodeCount); FNodes.AddObject(IntToStr(NodeCount),Node); end; end; procedure TTemplate.RemoveNode(Node: Pointer); var idx: integer; begin if(dmodShared.InEditor) then begin idx := FNodes.IndexOfObject(Node); if(idx >= 0) then FNodes.Delete(idx); end; end; { Creates a new Template that looks like the old one, but with a new Owner } { - an example of where this is needed: when a shared template in a user's } { personal folder is modified, we need to create a copy of the shared } { template, make it a personal template, and make the changes to the copy } function TTemplate.Clone(Owner: Int64): TTemplate; var i: integer; begin Result := Self; if(FPersonalOwner <> Owner) and (RealType in [ttDoc, ttGroup, ttClass]) then begin Result := TrueClone; Result.FCloning := TRUE; try Result.FID := '0'; GetItems; Result.FPersonalOwner := Owner; Result.Expanded := TRUE; Result.GetItems; for i := 0 to Items.Count-1 do Result.Items.Add(Items[i]); Result.BackupItems; Templates.AddObject(Result.ID, Result); finally Result.FCloning := FALSE; end; end; end; { Creates a duplicate Template - used for backups and comparrisons } function TTemplate.TrueClone: TTemplate; var Code, DataStr: string; begin DataStr := ID+U+TemplateTypeCodes[RealType]+U+TemplateActiveCode[Active]+U+PrintName+U; if(Exclude) then DataStr := DataStr + '1' else DataStr := DataStr + '0'; case GetChildren of tcActive: Code := '1'; tcInactive: Code := '2'; tcBoth: Code := '3'; else Code := '0'; end; DataStr := DataStr + U + IntToStr(Gap) + U + IntToStr(PersonalOwner) + U + Code + U + BOOLCHAR[Dialog] + U + BOOLCHAR[DisplayOnly] + U + BOOLCHAR[FirstLine] + U + BOOLCHAR[OneItemOnly] + U + BOOLCHAR[HideDlgItems] + U + BOOLCHAR[HideItems] + U + BOOLCHAR[IndentItems] + U + FReminderDialog; SetPiece(DataStr,U,18,BOOLCHAR[Lock]); SetPiece(DataStr,U,19,IntToStr(COMObject)); SetPiece(DataStr,U,20,COMParam); SetPiece(DataStr,U,21,FileLink); Result := TTemplate.Create(DataStr); Result.FCloning := TRUE; try Result.SetBoilerplate(GetBoilerplate); Result.SetDescription(GetDescription); finally Result.FCloning := FALSE; end; end; function TTemplate.ItemIENs: string; var i: integer; begin GetItems; Result := ''; for i := 0 to FItems.Count-1 do Result := Result + TTemplate(FItems[i]).FID+','; end; function TemplateChildrenCompare(Item1, Item2: Pointer): Integer; begin Result := CompareText(TTemplate(Item1).PrintName,TTemplate(Item2).PrintName); end; procedure TTemplate.SortChildren; begin GetItems; if (FItems.Count > 1) and CanModify then FItems.Sort(TemplateChildrenCompare); end; procedure TTemplate.BackupItems; begin with FBkup do begin if((not SavedItemIENs) and assigned(FItems)) then begin BItemIENs := ItemIENs; SavedItemIENs := TRUE; end; end; end; procedure TTemplate.SetActive(const Value: boolean); begin if(FActive <> Value) and CanModify then begin with FBkup do begin if(not SavedActive) and ValidID then begin BActive := FActive; SavedActive := TRUE; end; end; FActive := Value; end; end; procedure TTemplate.SetExclude(const Value: boolean); begin if(FExclude <> Value) and CanModify then begin with FBkup do begin if(not SavedExclude) and ValidID then begin BExclude := FExclude; SavedExclude := TRUE; end; end; FExclude := Value; end; end; procedure TTemplate.SetDialog(const Value: boolean); begin if(FDialog <> Value) and CanModify then begin with FBkup do begin if(not SavedDialog) and ValidID then begin BDialog := FDialog; SavedDialog := TRUE; end; end; FDialog := Value; end; end; procedure TTemplate.SetGap(const Value: integer); begin if(FGap <> Value) and CanModify then begin with FBkup do begin if(not SavedGap) and ValidID then begin BGap := FGap; SavedGap := TRUE; end; end; FGap := Value; end; end; procedure TTemplate.SetPrintName(const Value: string); begin if(FPrintName <> Value) and CanModify then begin with FBkup do begin if(not SavedPrintName) and ValidID then begin BPrintName := FPrintName; SavedPrintName := TRUE; end; end; FPrintName := Value; end; end; procedure TTemplate.SetRealType(const Value: TTemplateType); begin if(FRealType <> Value) and CanModify then begin with FBkup do begin if(not SavedRealType) and ValidID then begin BRealType := FRealType; SavedRealType := TRUE; end; end; FRealType := Value; if(FFileLink <> '') and (not (FRealType in [ttDoc, ttGroup])) then SetFileLink(''); end; end; procedure TTemplate.ClearBackup(ClearItemIENs: boolean = TRUE); begin with FBkup do begin SavedPrintName := FALSE; SavedGap := FALSE; SavedRealType := FALSE; SavedActive := FALSE; SavedDisplayOnly := FALSE; SavedFirstLine := FALSE; SavedOneItemOnly := FALSE; SavedHideDlgItems := FALSE; SavedHideItems := FALSE; SavedIndentItems := FALSE; SavedLock := FALSE; SavedExclude := FALSE; SavedDialog := FALSE; SavedPersonalOwner := FALSE; SavedBoilerPlate := FALSE; SavedDescription := FALSE; SavedReminderDialog := FALSE; SavedCOMObject := FALSE; SavedCOMParam := FALSE; SavedFileLink := FALSE; if(ClearItemIENs) then begin if(FExpanded) then begin BItemIENs := ItemIENs; SavedItemIENs := TRUE; end else SavedItemIENs := FALSE; end; end; end; function TTemplate.Changed: boolean; begin Result := not ValidID; with FBkup do begin if(not Result) and (SavedPrintName) then Result := (BPrintName <> FPrintName); if(not Result) and (SavedGap) then Result := (BGap <> FGap); if(not Result) and (SavedRealType) then Result := (BRealType <> FRealType); if(not Result) and (SavedActive) then Result := (BActive <> FActive); if(not Result) and (SavedDisplayOnly) then Result := (BDisplayOnly <> FDisplayOnly); if(not Result) and (SavedFirstLine) then Result := (BFirstLine <> FFirstLine); if(not Result) and (SavedOneItemOnly) then Result := (BOneItemOnly <> FOneItemOnly); if(not Result) and (SavedHideDlgItems) then Result := (BHideDlgItems <> FHideDlgItems); if(not Result) and (SavedHideItems) then Result := (BHideItems <> FHideItems); if(not Result) and (SavedIndentItems) then Result := (BIndentItems <> FIndentItems); if(not Result) and (SavedLock) then Result := (BLock <> FLock); if(not Result) and (SavedExclude) then Result := (BExclude <> FExclude); if(not Result) and (SavedDialog) then Result := (BDialog <> FDialog); if(not Result) and (SavedPersonalOwner) then Result := (BPersonalOwner <> FPersonalOwner); if(not Result) and (SavedReminderDialog) then Result := (BReminderDialog <> FReminderDialog); if(not Result) and (SavedCOMObject) then Result := (BCOMObject <> FCOMObject); if(not Result) and (SavedCOMParam) then Result := (BCOMParam <> FCOMParam); if(not Result) and (SavedFileLink) then Result := (BFileLink <> FFileLink); if(not Result) and (SavedBoilerplate) then Result := (BBoilerplate <> FBoilerplate); if(not Result) and (SavedDescription) then Result := (BDescription <> FDescription); if(not Result) and (SavedItemIENs) then Result := (BItemIENs <> ItemIENs); // Keep last end; end; procedure TTemplate.SetDescription(const Value: string); begin if(FDescription <> Value) and CanModify then begin with FBkup do begin if(FDescriptionLoaded and (not SavedDescription) and ValidID) then begin BDescription := FDescription; SavedDescription := TRUE; end; end; FDescription := Value; end; FDescriptionLoaded := TRUE; end; function TTemplate.GetDescription: string; begin if(not FDescriptionLoaded) then begin StatusText('Loading Template Boilerplate...'); try LoadTemplateDescription(FID); FDescription := RPCBrokerV.Results.Text; finally StatusText(''); end; FDescriptionLoaded := TRUE; end; Result := FDescription; end; procedure TTemplate.SetDisplayOnly(const Value: boolean); begin if(FDisplayOnly <> Value) and CanModify then begin with FBkup do begin if(not SavedDisplayOnly) and ValidID then begin BDisplayOnly := FDisplayOnly; SavedDisplayOnly := TRUE; end; end; FDisplayOnly := Value; end; end; procedure TTemplate.SetFirstLine(const Value: boolean); begin if(FFirstLine <> Value) and CanModify then begin with FBkup do begin if(not SavedFirstLine) and ValidID then begin BFirstLine := FFirstLine; SavedFirstLine := TRUE; end; end; FFirstLine := Value; end; end; procedure TTemplate.SetHideItems(const Value: boolean); begin if(FHideItems <> Value) and CanModify then begin with FBkup do begin if(not SavedHideItems) and ValidID then begin BHideItems := FHideItems; SavedHideItems := TRUE; end; end; FHideItems := Value; end; end; procedure TTemplate.SetIndentItems(const Value: boolean); begin if(FIndentItems <> Value) and CanModify then begin with FBkup do begin if(not SavedIndentItems) and ValidID then begin BIndentItems := FIndentItems; SavedIndentItems := TRUE; end; end; FIndentItems := Value; end; end; procedure TTemplate.SetOneItemOnly(const Value: boolean); begin if(FOneItemOnly <> Value) and CanModify then begin with FBkup do begin if(not SavedOneItemOnly) and ValidID then begin BOneItemOnly := FOneItemOnly; SavedOneItemOnly := TRUE; end; end; FOneItemOnly := Value; end; end; procedure TTemplate.SetHideDlgItems(const Value: boolean); begin if(FHideDlgItems <> Value) and CanModify then begin with FBkup do begin if(not SavedHideDlgItems) and ValidID then begin BHideDlgItems := FHideDlgItems; SavedHideDlgItems := TRUE; end; end; FHideDlgItems := Value; end; end; function TTemplate.DlgID: string; begin Result := IntToStr(StrToIntDef(FID, 0)); if(Result = '0') then begin if(FLastDlgCnt <> uDlgCount) then begin FLastDlgCnt := uDlgCount; inc(uUniqueIDNum); FLastUniqueID := uUniqueIDNum; end; Result := '-' + inttostr(FLastUniqueID); end; end; function TTemplate.DialogProperties(Parent: TTemplate = nil): string; var Show, ToggleItems: boolean; bGap: integer; GroupIdx: string; begin GroupIdx := '0'; bGap := 0; if(assigned(parent)) then begin Show := ((not Parent.HideDlgItems) or (Parent.Boilerplate = '')); // if(Parent.Boilerplate <> '') and (Parent.OneItemOnly) then if(Parent.OneItemOnly) then GroupIdx := Parent.DlgID; if(Parent.RealType = ttGroup) then bGap := Parent.Gap; end else Show := TRUE; ToggleItems := ((HideDlgItems) and (Boilerplate <> '')); Result := BOOLCHAR[DisplayOnly] + BOOLCHAR[FirstLine] + BOOLCHAR[Show] + BOOLCHAR[ToggleItems] + IntToStr(bGap) + // Depends on Gap being 1 character in length ';' + GroupIdx + ';' + DlgID; if(assigned(Parent)) then SetPiece(Result, ';', 4, Parent.DlgID); SetPiece(Result,';',5, inttostr(uIndentLevel)); end; function TTemplate.GetDialogAborted: boolean; begin Result := FDialogAborted; FDialogAborted := FALSE; end; function TTemplate.IsDialog: boolean; begin Result := (FDialog and (FRealType = ttGroup)); end; function TTemplate.CanExportXML(Data, Fields: TStringList; IndentLevel: integer = 0): boolean; var Pad, Tmp: string; i: integer; begin if BadTemplateName(PrintName) then begin InfoBox('Can not export template.' + CRLF + 'Template has an invalid name: ' + PrintName + '.' + BadNameText, 'Error', MB_OK or MB_ICONERROR); Result := FALSE; exit; end; Result := TRUE; Pad := StringOfChar(' ',IndentLevel); Data.Add(Pad + '<' + XMLTemplateTag + ' ' + TemplateExportTag[efName] + '="' + Text2XML(PrintName) + '">'); AddXMLData(Data, Pad, efBlankLines, IntToStr(Gap), '0'); if(RealType in AllTemplateRootTypes) then Tmp := TemplateTypeCodes[ttClass] else Tmp := TemplateTypeCodes[RealType]; AddXMLData(Data, Pad, efType, Tmp, ''); AddXMLData(Data, Pad, efStatus, TemplateActiveCode[Active], ''); AddXMLBool(Data, Pad, efExclude, Exclude); AddXMLBool(Data, Pad, efDialog, Dialog); AddXMLBool(Data, Pad, efDisplayOnly, DisplayOnly); AddXMLBool(Data, Pad, efFirstLine, FirstLine); AddXMLBool(Data, Pad, efOneItemOnly, OneItemOnly); AddXMLBool(Data, Pad, efHideDialogItems, HideDlgItems); AddXMLBool(Data, Pad, efHideTreeItems, HideItems); AddXMLBool(Data, Pad, efIndentItems, IndentItems); AddXMLBool(Data, Pad, efLock, Lock); AddXMLList(Data, Fields, Pad, efBoilerplate, GetBoilerplate); AddXMLList(Data, Fields, Pad, efDescription, GetDescription); GetItems; if(FItems.Count > 0) then begin Data.Add(Pad + ' <' + TemplateExportTag[efItems] + '>'); for i := 0 to FItems.Count-1 do begin Result := TTemplate(FItems[i]).CanExportXML(Data, Fields, IndentLevel + 4); if(not Result) then exit; end; Data.Add(Pad + ' '); end; Data.Add(Pad + ''); end; procedure TTemplate.UpdateImportedFieldNames(List: TStrings); const SafeCode = #1 + '^@^' + #2; SafeCodeLen = length(SafeCode); var i, p, l1: integer; Tag1, Tag2, tmp: string; First, ok: boolean; begin GetBoilerplate; ok := TRUE; First := TRUE; for i := 0 to List.Count-1 do begin if(Piece(List[i],U,2) = '0') then begin Tag1 := TemplateFieldBeginSignature + Piece(List[i],U,1) + TemplateFieldEndSignature; Tag2 := TemplateFieldBeginSignature + SafeCode + Piece(List[i],U,3) + TemplateFieldEndSignature; l1 := length(Tag1); repeat p := pos(Tag1, FBoilerplate); if(p > 0) then begin if First then begin ok := CanModify; First := FALSE; end; if ok then begin tmp := copy(FBoilerplate,1,p-1) + Tag2 + copy(FBoilerplate,p+l1, MaxInt); FBoilerplate := tmp; end else p := 0; end; until (p = 0); end; if not ok then break; end; if ok then begin repeat p := pos(SafeCode, FBoilerplate); if(p > 0) then delete(FBoilerplate, p, SafeCodeLen); until (p = 0); GetItems; for i := 0 to FItems.Count-1 do TTemplate(FItems[i]).UpdateImportedFieldNames(List); end; end; procedure TTemplate.SetReminderDialog(const Value: string); begin if(FReminderDialog <> Value) and CanModify then begin with FBkup do begin if(not SavedReminderDialog) and ValidID then begin BReminderDialog := FReminderDialog; SavedReminderDialog := TRUE; end; end; FReminderDialog := Value; FIsReminderDialog := (ReminderDialogIEN <> ''); if FIsReminderDialog and (not (LinkType in [ltNone, ltTitle])) then SetFileLink(''); end; end; function TTemplate.ReminderDialogIEN: string; begin Result := Piece(FReminderDialog,U,1); if Result = '0' then Result := ''; end; function TTemplate.ReminderDialogName: string; begin Result := Piece(FReminderDialog,U,2); end; function TTemplate.CanModify: boolean; begin if(not FLocked) and ValidID and (not FCloning) then begin FLocked := LockTemplate(FID); Result := FLocked; if(not FLocked) then begin if(assigned(dmodShared.OnTemplateLock)) then dmodShared.OnTemplateLock(Self) else ShowMessage(Format(TemplateLockedText, [FPrintName])); end; end else Result := TRUE; end; function TTemplate.ValidID: boolean; begin Result := ((FID <> '0') and (FID <> '')); end; procedure TTemplate.Unlock; begin if FLocked and ValidID then begin UnlockTemplate(FID); FLocked := FALSE; end; end; procedure TTemplate.SetLock(const Value: boolean); begin if(FLock <> Value) and CanModify then begin with FBkup do begin if(not SavedLock) and ValidID then begin BLock := FLock; SavedLock := TRUE; end; end; FLock := Value; end; end; function TTemplate.IsLocked: boolean; begin Result := (FLock and (FPersonalOwner = 0)) or AutoLock; end; procedure TTemplate.SetCOMObject(const Value: integer); begin if(FCOMObject <> Value) and CanModify then begin with FBkup do begin if(not SavedCOMObject) and ValidID then begin BCOMObject := FCOMObject; SavedCOMObject := TRUE; end; end; FCOMObject := Value; FIsCOMObject := (FCOMObject > 0); end; end; procedure TTemplate.SetCOMParam(const Value: string); begin if(FCOMParam <> Value) and CanModify then begin with FBkup do begin if(not SavedCOMParam) and ValidID then begin BCOMParam := FCOMParam; SavedCOMParam := TRUE; end; end; FCOMParam := Value; end; end; procedure TTemplate.AssignFileLink(const Value: string; Force: boolean); var i: integer; DoItems: boolean; begin DoItems := Force; if(FFileLink <> Value) and CanModify then begin with FBkup do begin if(not SavedFileLink) and ValidID then begin BFileLink := FFileLink; SavedFileLink := TRUE; end; end; FFileLink := Value; FLinkName := ''; if (not (LinkType in [ltNone, ltTitle])) then SetReminderDialog(''); if not DoItems then DoItems := (FFileLink <> ''); end; if DoItems then begin GetItems; for i := 0 to FItems.Count-1 do TTemplate(FItems[i]).AssignFileLink('', TRUE); end; end; procedure TTemplate.SetFileLink(const Value: string); begin AssignFileLink(Value, FALSE); end; //function TTemplate.COMObjectText(const DefText: string = ''; DocInfo: string = ''): string; function TTemplate.COMObjectText(DefText: string; var DocInfo: string): string; var p2: string; begin Result := ''; if (FCOMObject > 0) then begin p2 := ''; if (LinkType <> ltNone) and (LinkIEN <> '') then p2 := LinkPassCode[LinkType] + '=' + LinkIEN; Result := DefText; GetCOMObjectText(FCOMObject, p2, FCOMParam, Result, DocInfo); end; end; function TTemplate.AutoLock: boolean; begin Result := FIsCOMObject; if (not Result) and (not (RealType in AllTemplateLinkTypes)) and (LinkType <> ltNone) then Result := TRUE; end; function TTemplate.LinkType: TTemplateLinkType; var idx: TTemplateLinkType; begin Result := ltNone; case FRealType of ttTitles: Result := ltTitle; ttConsults: Result := ltConsult; ttProcedures: Result := ltProcedure; else begin for idx := succ(low(TTemplateLinkType)) to high(TTemplateLinkType) do begin if pos(LinkGlobal[idx], FFileLink) > 0 then begin Result := idx; break; end; end; end; end; end; function TTemplate.LinkIEN: string; begin Result := piece(FFileLink,';',1); end; function TTemplate.LinkName: string; begin if FLinkName = '' then FLinkName := GetLinkName(LinkIEN, LinkType); Result := FLinkName; end; procedure TTemplate.ExecuteReminderDialog(OwningForm: TForm); var sts: integer; txt: string; begin sts := IsRemDlgAllowed(ReminderDialogIEN); txt := ''; if sts < 0 then txt := 'Reminder Dialog has been Deleted or Deactivated.' else if sts = 0 then txt := 'You are not Authorized to use this Reminder Dialog in a Template' else ViewRemDlgTemplateFromForm(OwningForm, Self, TRUE, TRUE); if txt <> '' then InfoBox(txt,'Can not use Reminder Dialog', MB_OK or MB_ICONERROR); end; procedure ExpandEmbeddedFields(flds: TStringList); {07/26/01 S Monson Procedure to take a list of fields and expand it with any embedded fields. Handles embedded field loops (self referencing loops.)} var i,pos1,pos2: integer; ifield: TTemplateField; estring,next: string; begin if flds.count < 1 then Exit; i := 0; repeat ifield := GetTemplateField(flds[i],False); if ifield <> nil then begin estring := ''; case ifield.FldType of dftText,dftComboBox,dftButton, dftCheckBoxes,dftRadioButtons: estring := ifield.items; dftHyperlink: estring := ifield.EditDefault; end; while (estring <> '') do begin pos1 := pos(TemplateFieldBeginSignature,estring); if pos1 > 0 then begin estring := copy(estring,(pos1 + length(TemplateFieldBeginSignature)),maxint); pos2 := pos(TemplateFieldEndSignature,estring); if pos2 > 0 then begin next := copy(estring,1,pos2-1); delete(estring,1,pos2-1+length(TemplateFieldEndSignature)); if flds.IndexOf(next) < 0 then flds.add(next); end else estring := ''; end else estring := ''; end; inc(i); end else flds.Delete(i); until (i > flds.count-1); end; function MakeXMLParamTIU(ANoteID: string; ANoteRec: TEditNoteRec): string; var tmpList: TStringList; begin tmpList := TStringList.Create; try tmpList.Add(''); tmpList.Add(' ' + ANoteID + ''); tmpList.Add(' ' + IntToStr(ANoteRec.Author) + ''); tmpList.Add(' ' + ExternalName(ANoteRec.Author, 200) + ''); tmpList.Add(''); finally Result := tmpList.Text; tmpList.Free; end; end; function MakeXMLParamTIU(ADCSummID: string; ADCSummRec: TEditDCSummRec): string; var tmpList: TStringList; begin tmpList := TStringList.Create; try tmpList.Add(''); tmpList.Add(' ' + ADCSummID + ''); tmpList.Add(' ' + IntToStr(ADCSummRec.Dictator) + ''); tmpList.Add(' ' + ExternalName(ADCSummRec.Dictator, 200) + ''); tmpList.Add(''); finally Result := tmpList.Text; tmpList.Free; end; end; function GetXMLParamReturnValueTIU(DocInfo, ParamTag: string): string; var XMLDoc: IXMLDOMDocument; RootElement: IXMLDOMElement; TagElement: IXMLDOMNode; const NoIE5 = 'You must have Internet Explorer 5 or better installed to %s Templates'; NoIE5Header = 'Need Internet Explorer 5'; TIUHeader = 'TIU_DOC'; begin // After ExecuteTemplateOrBoilerPlate, DocInfo parameter may contain return value of AUTHOR. // Call this function at that point to get the value from the XML formatted parameter that's returned. Result := ''; try XMLDoc := CoDOMDocument.Create; except InfoBox(Format(NoIE5, ['use COM']), NoIE5Header, MB_OK); exit; end; try if assigned(XMLDoc) then begin XMLDoc.preserveWhiteSpace := TRUE; if DocInfo <> '' then XMLDoc.LoadXML(DocInfo); RootElement := XMLDoc.DocumentElement; if not assigned(RootElement) then exit; try if(RootElement.tagName <> TIUHeader) then exit else begin TagElement := FindXMLElement(RootElement, ParamTag); if assigned(TagElement) then Result := TagElement.Text else Result := ''; end; finally TagElement := nil; RootElement := nil; end; end; finally XMLDoc := nil; end; end; function TTemplate.ReminderWipe: string; begin Result := Piece(FReminderDialog,U,3); end; initialization finalization ReleaseTemplates; end.