Changeset 654 for cprs/branches/tmg-cprs/CPRS-Chart/Templates

Timestamp:

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

Author:

Kevin Toppenberg

Message:

Added HTML templating

Location:

cprs/branches/tmg-cprs/CPRS-Chart/Templates

Files:

• fTemplateDialog.pas (modified) (14 diffs)
• uTemplateFields.pas (modified) (10 diffs)
• uTemplates.pas (modified) (2 diffs)

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

@@ -6 +6 @@
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
-  StdCtrls, ExtCtrls, ORCtrls, ORFn, AppEvnts, uTemplates, DKLang;
+  StdCtrls, StrUtils, ExtCtrls, ORCtrls, ORFn, AppEvnts, uTemplates, DKLang;
 
 type
@@ -44 +44 @@
     FCheck4Required: boolean;
     FSilent: boolean;
+    FHTMLMode : boolean; //kt added 12/28/09
+    FAnswerOpenTag : string; //kt added 12/28/09
+    FAnswerCloseTag : string; //kt added 12/28/09
     procedure SizeFormToCancelBtn();
     procedure ChkAll(Chk: boolean);
@@ -59 +62 @@
     procedure ParentCBEnter(Sender: TObject);
     procedure ParentCBExit(Sender: TObject);
+    procedure SetAnswerHTMLTag(Value : string); //kt 12/28/09
   public
     property Silent: boolean read FSilent write FSilent ;
+    property HTMLMode : boolean read FHTMLMode write FHTMLMode; //kt added 12/28/09
+    property HTMLAnswerOpenTag : string read FAnswerOpenTag write SetAnswerHTMLTag;  //kt added 12/28/09
+    property HTMLAnswerCloseTag : string read FAnswerCloseTag write SetAnswerHTMLTag;  //kt added 12/28/09
   published
   end;
@@ -66 +73 @@
 // Returns True if Cancel button is pressed
 function DoTemplateDialog(SL: TStrings; const CaptionText: string; PreviewMode: boolean = FALSE): boolean;
+function RemoveHTMLTags(Txt : string) : string;
+function FormatHTMLTags(Txt : string): string;
 procedure CheckBoilerplate4Fields(SL: TStrings; const CaptionText: string = ''; PreviewMode: boolean = FALSE); overload;
 procedure CheckBoilerplate4Fields(var AText: string; const CaptionText: string = ''; PreviewMode: boolean = FALSE); overload;
@@ -81 +90 @@
   Gap = 4;
   IndentGap = 18;
+  HTMLBEGINNINGTAG = '{HTML:';   //kt
+  HTMLENDINGTAG = '}';       //kt
+  HTMLBEGINNINGTAGLEN = length(HTMLBEGINNINGTAG);  //kt
+  HTMLENDINGTAGLEN = length(HTMLENDINGTAG);   //kt
 
 
@@ -89 +102 @@
   Save, Hidden: boolean;
   TmpCtrl: TStringList;
-
+  HTMLMode : boolean; //kt added 12/28/09
+  HTMLOpenTag,HTMLCloseTag : string; //kt added 12/28/09
 begin
   Txt := SL.Text;
   SL.Clear;
   TmpCtrl := TStringList.Create;
+  HTMLMode := frmTemplateDialog.HTMLMode; //kt added 12/28/09
+  HTMLOpenTag := frmTemplateDialog.HTMLAnswerOpenTag;  //kt added 12/28/09
+  HTMLCloseTag := frmTemplateDialog.HTMLAnswerCloseTag; //kt added 12/28/09
+  //kt added 12/28/09
   try
     for i := 0 to frmTemplateDialog.sbMain.ControlCount-1 do
@@ -117 +135 @@
         p2 := StrToInt(Piece(tmp,'~',2));
         Hidden := (copy(Piece(tmp,'~',3),2,1)=BOOLCHAR[TRUE]);
-        SL.Text := SL.Text + ResolveTemplateFields(Copy(Txt,p1,p2), FALSE, Hidden, IncludeEmbeddedFields);
+        //kt original line 12/28/09 --> SL.Text := SL.Text + ResolveTemplateFields(Copy(Txt,p1,p2), FALSE, Hidden, IncludeEmbeddedFields);
+        SL.Text := SL.Text + ResolveTemplateFields(Copy(Txt,p1,p2), FALSE, Hidden, IncludeEmbeddedFields,
+                                                   HTMLMode, HTMLOpenTag, HTMLCloseTag );
       end;
     end;
@@ -195 +215 @@
     DlgIDCounts.Duplicates := dupError;
     frmTemplateDialog.Caption := CaptionText;
+    frmTemplateDialog.HTMLMode := uTemplates.bUsingHTMLMode; //kt
+    frmTemplateDialog.HTMLAnswerOpenTag := '<I>'; //kt 12/28/09
+    //SL.Text := RemoveHTMLTags(SL.Text);  //elh
     AssignFieldIDs(SL);
     frmTemplateDialog.SL := SL;
@@ -237 +260 @@
       end;
       frmTemplateDialog.BuildAllControls;
-      repeat                      
+      repeat
          frmTemplateDialog.ShowModal;
-         if(frmTemplateDialog.ModalResult = mrOK) then
-           GetText(SL, TRUE)     {TRUE = Include embedded fields}
-         else
+         if(frmTemplateDialog.ModalResult = mrOK) then begin
+           GetText(SL, TRUE);     {TRUE = Include embedded fields}
+           if uTemplates.bUsingHTMLMode then begin
+              SL.Text := FormatHTMLTags(SL.Text);
+           end else begin
+              SL.Text := RemoveHTMLTags(SL.Text);
+           end;
+         end else begin
           if (not PreviewMode) and (not frmTemplateDialog.Silent) and (not uInit.TimedOut) then
             begin
@@ -262 +290 @@
               CancelDlg := TRUE;
             end;
+         end;      
       until CancelDlg or (frmTemplateDialog.ModalResult = mrOK)
     end
@@ -281 +310 @@
 end;
 
+function RemoveHTMLTags(Txt : string): string;
+var
+  beginning,ending : integer;
+  tempString,tempResult : string;
+begin
+  tempString := Txt;
+  //here we will strip out all HTML formatting tags  //elh
+  beginning := pos(HTMLBEGINNINGTAG, tempString);
+  if beginning = 0 then begin
+     Result := Txt;
+  end else begin
+    while beginning > 0 do
+    begin
+      tempResult := tempResult + Leftstr(tempString,beginning-1);
+      tempString := Rightstr(tempString,length(tempString)-beginning-HTMLBEGINNINGTAGLEN);
+      ending := pos(HTMLENDINGTAG, tempString);
+      tempString := Rightstr(tempString,length(tempString)-ending);
+      beginning := pos(HTMLBEGINNINGTAG, tempString);
+  //    tempString := Midstr(Txt,i,HTMLBEGINNINGTAGLEN);
+    end;
+    Result := tempResult + tempString;
+  end;
+end;
+
+function FormatHTMLTags(Txt : string): string;
+var
+  beginning,ending : integer;
+  tempString,tempResult : string;
+begin
+  tempString := Txt;
+  //here we will strip out all HTML formatting tags  //elh
+  beginning := pos(HTMLBEGINNINGTAG, tempString);
+  if beginning = 0 then begin
+     Result := Txt;
+  end else begin
+    while beginning > 0 do
+    begin
+      tempResult := tempResult + Leftstr(tempString,beginning-1);
+      tempString := Rightstr(tempString,length(tempString)-beginning-HTMLBEGINNINGTAGLEN+1);
+      ending := pos(HTMLENDINGTAG, tempString);
+      tempResult := tempResult + Leftstr(tempString,ending-1);
+      tempString := Rightstr(tempString,length(tempString)-ending);
+      beginning := pos(HTMLBEGINNINGTAG, tempString);
+  //    tempString := Midstr(Txt,i,HTMLBEGINNINGTAGLEN);
+    end;
+    Result := tempResult + tempString;
+  end;
+end;
+
 procedure CheckBoilerplate4Fields(SL: TStrings; const CaptionText: string = ''; PreviewMode: boolean = FALSE);
 begin
@@ -307 +385 @@
   finally
     tmp.free;
+  end;
+end;
+
+procedure TfrmTemplateDialog.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);
+    if Pos('/',Value)>0 then Value := Piece(Value,'/',2);
+    FAnswerOpenTag :='<'+Value+'>';
+    FAnswerCloseTag := '</' + Value + '>';
   end;
 end;
@@ -460 +553 @@
   end;
   tmp := copy(SL.Text, p1, p2);
+  tmp := RemoveHTMLTags(tmp);
   if(copy(tmp, length(tmp)-1, 2) = CRLF) then
     delete(tmp, length(tmp)-1, 2);
@@ -637 +731 @@
 procedure TfrmTemplateDialog.FormCreate(Sender: TObject);
 begin
+  FHTMLMode := false; //kt added 12/28/09
   BuildIdx := TStringList.Create;
   Entries := TStringList.Create;

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;
 

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

@@ -1886 +1886 @@
   Itm: string;
 begin
-  Result := GetBoilerplate;
+  Result := GetBoilerplate; //ELH
   if FIsReminderDialog or FIsCOMObject then exit;
   Itm := ItemBoilerplate;
@@ -1952 +1952 @@
           TmpSL.Text := rHTMLTools.Text2HTML(TmpSL);                //kt 8/09
         end;                                                        //kt 8/09
-        bUsingHTMLMode := false; //force reset each call.           //kt 8/09
+        //kt 12/28/09   bUsingHTMLMode := false; //force reset each call.           //kt 8/09
       end;                                                          //kt 8/09
       Result := TmpSL.Text;