Changeset 654 for cprs/branches/tmg-cprs/CPRS-Chart/Templates/uTemplateFields.pas

Timestamp:

Jan 4, 2010, 8:02:21 AM (14 years ago)

Author:

Kevin Toppenberg

Message:

Added HTML templating

File:

• cprs/branches/tmg-cprs/CPRS-Chart/Templates/uTemplateFields.pas (modified) (10 diffs)

cprs/branches/tmg-cprs/CPRS-Chart/Templates/uTemplateFields.pas

@@ -44 +44 @@
     FPanelDying: boolean;
     FOnDestroy: TNotifyEvent;
+    FHTMLMode : boolean; //kt added 12/28/09
+    FAnswerOpenTag : string; //kt added 12/28/09
+    FAnswerCloseTag : string; //kt added 12/28/09
     procedure KillLabels;
     function GetFieldValues: string;
     procedure SetFieldValues(const Value: string);
     procedure SetAutoDestroyOnPanelFree(const Value: boolean);
+    procedure SetAnswerHTMLTag(Value : string); //kt 12/28/09
+
   protected
     procedure UpDownChange(Sender: TObject);
@@ -67 +72 @@
     property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
     property FieldValues: string read GetFieldValues write SetFieldValues;
+    property HTMLMode : boolean read FHTMLMode write FHTMLMode; //kt added 12/28/09
+    property AnswerHTMLTag : string read FAnswerOpenTag write SetAnswerHTMLTag;  //kt added 12/28/09
     property AutoDestroyOnPanelFree: boolean read FAutoDestroyOnPanelFree
                                              write SetAutoDestroyOnPanelFree;
@@ -161 +168 @@
 procedure AssignFieldIDs(var Txt: string); overload;
 procedure AssignFieldIDs(SL: TStrings); overload;
-function ResolveTemplateFields(Text: string; AutoWrap: boolean; Hidden: boolean = FALSE; IncludeEmbedded: boolean = FALSE): string;
+//kt 12/28/09 originial --> function ResolveTemplateFields(Text: string; AutoWrap: boolean; Hidden: boolean = FALSE; IncludeEmbedded: boolean = FALSE): string;
+function ResolveTemplateFields(Text: string;
+                               AutoWrap: boolean;
+                               Hidden: boolean = FALSE;
+                               IncludeEmbedded: boolean = FALSE;
+                               HTMLMode : boolean = FALSE; //kt added 12/28/09
+                               HTMLAnswerOpenTag : string = ''; //kt added 12/28/09
+                               HTMLAnswerCloseTag : string = '' //kt added 12/28/09
+                               ): string;
 function AreTemplateFieldsRequired(const Text: string; FldValues: TORStringList =  nil): boolean;
 function HasTemplateField(txt: string): boolean;
@@ -179 +194 @@
   TemplateFieldBeginSignature = '{FLD:';
   TemplateFieldEndSignature = '}';
+  HTMLBEGINNINGTAG = '{HTML:';
+  HTMLENDINGTAG = '}';
+  HTMLBEGINNINGTAGLEN = length(HTMLBEGINNINGTAG);
+  HTMLENDINGTAGLEN = length(HTMLENDINGTAG);
   //MissingFieldsTxt = 'One or more required fields must still be entered.';  <-- original line.  //kt 8/8/2007
   function MissingFieldsTxt : string;  //kt added
@@ -519 +538 @@
                                AutoWrap: boolean;
                                Hidden: boolean = FALSE;
-                               IncludeEmbedded: boolean = FALSE): string;
+                               IncludeEmbedded: boolean = FALSE;
+                               HTMLMode : boolean = FALSE; //kt added 12/28/09
+                               HTMLAnswerOpenTag : string = ''; //kt added 12/28/09
+                               HTMLAnswerCloseTag : string = '' //kt added 12/28/09
+                               ): string;
 var
   flen, CtrlID, i, j: integer;
@@ -526 +549 @@
   FoundEntry: boolean;
   TmplFld: TTemplateField;
+  tempSL : TStringList;
 
   procedure AddNewTxt;
@@ -584 +608 @@
             if (assigned(TmplFld)) and (TmplFld.DateType in DateComboTypes) then {if this is a TORDateBox}
                NewTxt := Piece(NewTxt,':',1);          {we only want the first piece of NewTxt}
+            //kt 12/28/09 --- Start mod to wrap answers in custom HTML tag ---
+            if (HTMLMode=true) and (NewTxt <> '') then begin
+              NewTxt := HTMLAnswerOpenTag + NewTxt + HTMLAnswerCloseTag;   //kt 12/29/09
+            end;
+            //kt --- End mod to wrap answers in custom HTML tag ---
             AddNewTxt;
           end;
@@ -594 +623 @@
         end;
       end;
+    end else begin
+      if HTMLMode=true then begin
+        tempSL := TStringList.create;
+        tempSL.Text := Result;
+        if tempSL.Count < 3 then begin
+          Result := HTMLAnswerOpenTag + Result + HTMLAnswerCloseTag;
+        end;
+        tempSL.Free;
+      end;
     end;
   until(i = 0);
   if not AutoWrap then
     WordWrapText(Result);
+
 end;
 
@@ -1801 +1840 @@
   FID := AID;
   FText := Text;
+  FHTMLMode := false; //kt added 12/28/09
   FControls := TStringList.Create;
   FIndents := TStringList.Create;
@@ -2223 +2263 @@
 end;
 
+procedure TTemplateDialogEntry.SetAnswerHTMLTag(Value : string);
+//kt 12/28/09 Added entire function
+begin
+  if Value='' then begin
+    FAnswerOpenTag :='';
+    FAnswerCloseTag := '';
+  end else begin
+    if Pos('<',Value)>0 then Value := Piece(Value,'<',2);
+    if Pos('>',Value)>0 then Value := Piece(Value,'>',1);
+    FAnswerOpenTag :='<'+Value+'>';
+    FAnswerCloseTag := '</' + Value + '>';
+  end;
+end;
+
 function TTemplateDialogEntry.GetText: string;
 begin
-  Result := ResolveTemplateFields(FText, FALSE);
+  //kt Result := ResolveTemplateFields(FText, FALSE);
+  Result := ResolveTemplateFields(FText, FALSE, FALSE, FALSE, FHTMLMode, FAnswerOpenTag, FAnswerCloseTag); //kt 12/29/09
 end;