Ignore:
Timestamp:
Mar 31, 2010, 5:06:56 PM (15 years ago)
Author:
Kevin Toppenberg
Message:

Added functions to Templates, and Images tab

Location:
cprs/branches/tmg-cprs/CPRS-Chart/Templates
Files:
2 edited

Legend:

Unmodified
Added
Removed

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

    r698 r729  
    4747    FAnswerOpenTag : string; //kt added 12/28/09
    4848    FAnswerCloseTag : string; //kt added 12/28/09
     49    NameToObjID : TStringList; //kt added 3/26/10
     50    Formulas  : TStringList; //kt added 3/26/10
     51    TxtObjects  : TStringList; //kt added 3/28/10
    4952    procedure SizeFormToCancelBtn();
    5053    procedure ChkAll(Chk: boolean);
    … …  
    8184  frmTemplateDialog: TfrmTemplateDialog;
    8285
    83 const
    84   HTMLBEGINNINGTAG = '{HTML:';   //kt
    85   HTMLENDINGTAG = '}';       //kt
    86   HTMLBEGINNINGTAGLEN = length(HTMLBEGINNINGTAG);  //kt
    87   HTMLENDINGTAGLEN = length(HTMLENDINGTAG);   //kt
    88 
    8986implementation
    9087
    … …  
    153150  i, j, idx, Indent: integer;
    154151  DlgProps, Txt: string;
     152  Temp : string; //kt
     153  Changed : boolean; //kt
    155154  DlgIDCounts: TStringList;
    156155  DlgInt: TIntStruc;
    157156  CancelDlg: Boolean;
    158157  CancelMsg: String;
    159 
    160158
    161159  procedure IncDlgID(var id: string); //Appends an item count in the form of id.0, id.1, id.2, etc
    … …  
    221219    frmTemplateDialog.HTMLAnswerOpenTag := '<I>'; //kt 12/28/09
    222220    //SL.Text := RemoveHTMLTags(SL.Text);  //elh
    223     AssignFieldIDs(SL);
     221    AssignFieldIDs(SL,frmTemplateDialog.NameToObjID);   //kt  added NameToObjID param 3/26/10
     222    HideFormulas(SL,frmTemplateDialog.Formulas); //kt added 3/26/10
     223    HideTxtObjects(SL,frmTemplateDialog.TxtObjects); //kt added 3/28/10
    224224    frmTemplateDialog.SL := SL;
    225225    frmTemplateDialog.Index := '';
    … …  
    231231    repeat
    232232      i := pos(ObjMarker, Txt);
    233       if(i > 1) then
    234       begin
     233      if(i > 1) then begin
    235234        j := pos(DlgPropMarker, Txt);
    236         if(j > 0) then
    237           begin
     235        if(j > 0) then begin
    238236          DlgProps := copy(Txt, j + DlgPropMarkerLen, (i - j - DlgPropMarkerLen));
    239237          CountDlgProps(DlgProps);
    240           end
    241         else
    242           begin
     238        end else begin
    243239          DlgProps := '';
    244240          j := i;
    245           end;
     241        end;
    246242        inc(frmTemplateDialog.Count);
    247243        frmTemplateDialog.Index := frmTemplateDialog.Index +
    … …  
    249245        inc(idx,i+ObjMarkerLen-1);
    250246        Indent := StrToIntDef(Piece(DlgProps, ';', 5),0);
    251         if(frmTemplateDialog.FirstIndent > Indent) then
     247        if(frmTemplateDialog.FirstIndent > Indent) then begin
    252248          frmTemplateDialog.FirstIndent := Indent;
    253       end;
    254       if(i > 0) then
     249        end;
     250      end;
     251      if(i > 0) then begin
    255252        delete(txt, 1, i + ObjMarkerLen - 1);
     253      end;
    256254    until (i = 0);
    257     if(frmTemplateDialog.Count > 0) then
    258     begin
    259       if(frmTemplateDialog.OneOnly) then
    260       begin
     255    if(frmTemplateDialog.Count > 0) then begin
     256      if(frmTemplateDialog.OneOnly) then begin
    261257        frmTemplateDialog.btnNone.Visible := FALSE;
    262258        frmTemplateDialog.btnAll.Visible := FALSE;
    … …  
    264260      frmTemplateDialog.BuildAllControls;
    265261      repeat
    266          if (assigned(frmNotes)) and (frmTemplateDialog.HTMLMode) then frmNotes.HTMLEditor.SetMsgActive(False);  //kt 2-1-10
    267          frmTemplateDialog.ShowModal;
    268          if (assigned(frmNotes)) and (frmTemplateDialog.HTMLMode) then frmNotes.HTMLEditor.SetMsgActive(True);   //kt 2-1-10
    269          if(frmTemplateDialog.ModalResult = mrOK) then begin
    270            GetText(SL, TRUE);     {TRUE = Include embedded fields}
    271            {
    272            if uTemplates.bUsingHTMLMode then begin
    273               SL.Text := FormatHTMLTags(SL.Text);
    274            end else begin
    275               SL.Text := RemoveHTMLTags(SL.Text);
    276            end;
    277            }
    278          end else begin
    279           if (not PreviewMode) and (not frmTemplateDialog.Silent) and (not uInit.TimedOut) then
    280             begin
    281 //            CancelMsg := 'If you cancel, your changes will not be saved.  Are you sure you want to cancel?';  <-- original line.  //kt 8/8/2007
    282               CancelMsg := DKLangConstW('fTemplateDialog_If_you_cancelx_your_changes_will_not_be_savedx__Are_you_sure_you_want_to_cancelx'); //kt added 8/8/2007
    283 //            if (InfoBox(CancelMsg, 'Cancel Dialog Processing', MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) = ID_YES) then   <-- original line.  //kt 8/8/2007
    284               if (InfoBox(CancelMsg, DKLangConstW('fTemplateDialog_Cancel_Dialog_Processing'), MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) = ID_YES) then  //kt added 8/8/2007
    285                 begin
    286                   SL.Clear;
    287                   Result := TRUE;
    288                   CancelDlg := TRUE;
    289                 end
    290               else
    291                 CancelDlg := FALSE;
    292             end
    293           else
    294             begin
     262        if (assigned(frmNotes)) and (frmTemplateDialog.HTMLMode) then frmNotes.HTMLEditor.SetMsgActive(False);  //kt 2-1-10
     263        frmTemplateDialog.ShowModal;
     264        if (assigned(frmNotes)) and (frmTemplateDialog.HTMLMode) then frmNotes.HTMLEditor.SetMsgActive(True);   //kt 2-1-10
     265        if(frmTemplateDialog.ModalResult = mrOK) then begin
     266          //kt -- begin mod --  3/27/10
     267          Changed := RestoreTransformTxtObjects(SL, frmTemplateDialog.TxtObjects, frmTemplateDialog.NameToObjID);
     268          Changed := RestoreTransformFormulas(SL, frmTemplateDialog.Formulas, frmTemplateDialog.NameToObjID) or Changed;
     269          if Changed then begin //kt 3/27/10
     270            Txt := SL.Text;
     271            i := pos(ObjMarker, Txt);
     272            if(i > 1) then begin
     273              j := pos(DlgPropMarker, Txt);
     274              if (j <= 0) then j := i;
     275              Temp := frmTemplateDialog.Index;
     276              SetPiece(Temp,'~',2,IntToStr(j-1));
     277              frmTemplateDialog.Index := Temp;
     278            end;
     279          end;
     280          //kt -- end mod --
     281          GetText(SL, TRUE);     {TRUE = Include embedded fields}
     282          {
     283          if uTemplates.bUsingHTMLMode then begin
     284             SL.Text := FormatHTMLTags(SL.Text);
     285          end else begin
     286             SL.Text := RemoveHTMLTags(SL.Text);
     287          end;
     288          }
     289        end else begin
     290          if (not PreviewMode) and (not frmTemplateDialog.Silent) and (not uInit.TimedOut) then begin
     291//          CancelMsg := 'If you cancel, your changes will not be saved.  Are you sure you want to cancel?';  <-- original line.  //kt 8/8/2007
     292            CancelMsg := DKLangConstW('fTemplateDialog_If_you_cancelx_your_changes_will_not_be_savedx__Are_you_sure_you_want_to_cancelx'); //kt added 8/8/2007
     293//          if (InfoBox(CancelMsg, 'Cancel Dialog Processing', MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) = ID_YES) then   <-- original line.  //kt 8/8/2007
     294            if (InfoBox(CancelMsg, DKLangConstW('fTemplateDialog_Cancel_Dialog_Processing'), MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) = ID_YES) then begin  //kt added 8/8/2007
    295295              SL.Clear;
    296296              Result := TRUE;
    297297              CancelDlg := TRUE;
     298            end else begin
     299              CancelDlg := FALSE;
    298300            end;
    299          end;     
     301          end else begin
     302            SL.Clear;
     303            Result := TRUE;
     304            CancelDlg := TRUE;
     305          end;
     306        end;
    300307      until CancelDlg or (frmTemplateDialog.ModalResult = mrOK)
    301     end
    302     else
     308    end else begin
    303309      SL.Clear;
     310    end;
    304311  finally
    305312    //frmTemplateDialog.Free;    v22.11e RV
    … …  
    324331  tempString := Txt;
    325332  //here we will strip out all HTML formatting tags  //elh
    326   beginning := pos(HTMLBEGINNINGTAG, tempString);
     333  beginning := pos(HTML_BEGIN_TAG, tempString);
    327334  if beginning = 0 then begin
    328335     Result := Txt;
    … …  
    331338    begin
    332339      tempResult := tempResult + Leftstr(tempString,beginning-1);
    333       tempString := Rightstr(tempString,length(tempString)-beginning-HTMLBEGINNINGTAGLEN);
    334       ending := pos(HTMLENDINGTAG, tempString);
     340      tempString := Rightstr(tempString,length(tempString)-beginning-HTML_BEGIN_TAGLEN);
     341      ending := pos(HTML_ENDING_TAG, tempString);
    335342      tempString := Rightstr(tempString,length(tempString)-ending);
    336       beginning := pos(HTMLBEGINNINGTAG, tempString);
    337   //    tempString := Midstr(Txt,i,HTMLBEGINNINGTAGLEN);
     343      beginning := pos(HTML_BEGIN_TAG, tempString);
     344  //    tempString := Midstr(Txt,i,HTML_BEGIN_TAGLEN);
    338345    end;
    339346    Result := tempResult + tempString;
    … …  
    348355  tempString := Txt;
    349356  //here we will strip out all HTML formatting tags  //elh
    350   beginning := pos(HTMLBEGINNINGTAG, tempString);
     357  beginning := pos(HTML_BEGIN_TAG, tempString);
    351358  if beginning = 0 then begin
    352359     Result := Txt;
    … …  
    355362    begin
    356363      tempResult := tempResult + Leftstr(tempString,beginning-1);
    357       tempString := Rightstr(tempString,length(tempString)-beginning-HTMLBEGINNINGTAGLEN+1);
    358       ending := pos(HTMLENDINGTAG, tempString);
     364      tempString := Rightstr(tempString,length(tempString)-beginning-HTML_BEGIN_TAGLEN+1);
     365      ending := pos(HTML_ENDING_TAG, tempString);
    359366      tempResult := tempResult + Leftstr(tempString,ending-1);
    360367      tempString := Rightstr(tempString,length(tempString)-ending);
    361       beginning := pos(HTMLBEGINNINGTAG, tempString);
    362   //    tempString := Midstr(Txt,i,HTMLBEGINNINGTAGLEN);
     368      beginning := pos(HTML_BEGIN_TAG, tempString);
     369  //    tempString := Midstr(Txt,i,HTML_BEGIN_TAGLEN);
    363370    end;
    364371    Result := tempResult + tempString;
    … …  
    565572  end;
    566573  tmp := copy(SL.Text, p1, p2);
    567   tmp := RemoveHTMLTags(tmp);
     574  tmp := RemoveHTMLTags(tmp);  //kt
    568575  if(copy(tmp, length(tmp)-1, 2) = CRLF) then
    569576    delete(tmp, length(tmp)-1, 2);
    … …  
    747754  Entries := TStringList.Create;
    748755  NoTextID := TStringList.Create;
     756  NameToObjID := TStringList.Create ; //kt
     757  Formulas  := TStringList.Create ; //kt
     758  TxtObjects  := TStringList.Create; //kt added 3/28/10
    749759  FOldHintEvent := Application.OnShowHint;
    750760  Application.OnShowHint := AppShowHint;
    … …  
    774784  Entries.Free;
    775785  BuildIdx.Free;
     786  NameToObjID.Free; //kt
     787  Formulas.Free; //kt
     788  TxtObjects.Free; //kt
    776789end;
    777790

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

    r694 r729  
    66uses
    77  Forms, SysUtils, StrUtils, Classes, Dialogs, StdCtrls, ExtCtrls, Controls, Contnrs,
    8   Graphics, ORClasses, ComCtrls, ORDtTm;
     8  Graphics, ORClasses, ComCtrls, ORDtTm, uEvaluate;
    99
    1010type
    … …  
    166166function GetDialogEntry(AParent: TWinControl; AID, AText: string): TTemplateDialogEntry;
    167167procedure FreeEntries(SL: TStrings);
    168 procedure AssignFieldIDs(var Txt: string); overload;
    169 procedure AssignFieldIDs(SL: TStrings); overload;
     168//kt 3/26/10 --> original  procedure AssignFieldIDs(var Txt: string); overload;
     169procedure AssignFieldIDs(var Txt: string; NameToObjID : TStringList=nil); overload;  //kt 3/26/10
     170//kt 3/26/10 --> original procedure AssignFieldIDs(SL: TStrings); overload;
     171procedure AssignFieldIDs(SL: TStrings; NameToObjID : TStringList=nil); overload; //kt 3/26/10
     172procedure HideFormulas(SL : TStrings; Formulas : TStringList); //kt added 3/26/10
     173procedure HideTxtObjects(SL : TStrings; TxtObjects : TStringList); //kt added 3/28/10
     174//function RestoreTransformFormulas(var Txt : string; Formulas, NameToObjID : TStringList) : boolean; overload; //kt added 3/26/10
     175function RestoreTransformFormulas(SL : TStrings; Formulas, NameToObjID : TStringList) : boolean; {overload; }//kt added 3/26/10
    170176//kt 12/28/09 originial --> function ResolveTemplateFields(Text: string; AutoWrap: boolean; Hidden: boolean = FALSE; IncludeEmbedded: boolean = FALSE): string;
     177function RestoreTransformTxtObjects(SL : TStrings; TxtObjects, NameToObjID : TStringList) : boolean;
    171178function ResolveTemplateFields(Text: string;
    172179                               AutoWrap: boolean;
    … …  
    190197procedure ConvertCodes2Text(sl: TStrings; Short: boolean);
    191198function StripEmbedded(iItems: string): string;
     199function CloseCharPos(OpenChar, CloseChar : char; var Txt : string; StartingPos : integer=1) : integer; //kt added
     200
     201type
     202  TMGExtension = (tmgeFN,tmgeOBJ);
     203  TMGExtMatch = record
     204    Signature : string;
     205    SigLen : integer;
     206    EndTag : char;
     207  end;
     208  TMGExtArray = array[tmgeFN..tmgeOBJ] of TMGExtMatch;
    192209
    193210const
    194211  TemplateFieldBeginSignature = '{FLD:';
    195212  TemplateFieldEndSignature = '}';
    196   HTMLBEGINNINGTAG = '{HTML:';
    197   HTMLENDINGTAG = '}';
    198   HTMLBEGINNINGTAGLEN = length(HTMLBEGINNINGTAG);
    199   HTMLENDINGTAGLEN = length(HTMLENDINGTAG);
     213  HTML_BEGIN_TAG = '{HTML:';                      //kt
     214  HTML_ENDING_TAG = '}';                          //kt
     215  HTML_BEGIN_TAGLEN = length(HTML_BEGIN_TAG);     //kt
     216  HTML_ENDING_TAGLEN = length(HTML_ENDING_TAG);   //kt
     217  FN_BEGIN_SIGNATURE = '{FN:';                    //kt
     218  FN_BEGIN_TAG = '{';                             //kt
     219  FN_END_TAG = '}';                               //kt
     220  FN_BEGIN_SIGNATURE_LEN = length(FN_BEGIN_SIGNATURE);//kt
     221  FN_END_TAGLEN = length(FN_END_TAG);             //kt
     222  FN_SHOW_TEXT = '{%_____%-#';                    //kt
     223  FN_SHOW_TEXT_END = '}';                         //kt
     224  FN_SHOW_TEXT_LEN = length(FN_SHOW_TEXT);        //kt
     225  FN_SHOW_TEXT_END_LEN = length(FN_SHOW_TEXT_END);//kt
     226  FN_FIELD_TAG = '[FLD:';                         //kt
     227  FN_FIELD_TAG_LEN = length(FN_FIELD_TAG);        //kt
     228  FN_OBJ_TAG = '[OBJ:';                           //kt
     229  FN_OBJ_TAG_LEN = length(FN_OBJ_TAG);            //kt
     230  FLD_OBJ_SIGNATURE = '{OBJ:';                    //kt
     231  FLD_OBJ_END_TAG = '}';                          //kt
     232  FLD_OBJ_SIG_LEN = length(FLD_OBJ_SIGNATURE);    //kt
     233  OBJ_SHOW_TEXT = '{OBJ%_____%-#';                //kt
     234  OBJ_SHOW_TEXT_END = '}';                        //kt
     235  OBJ_SHOW_TEXT_LEN = length(OBJ_SHOW_TEXT);      //kt
     236  TMG_MATCH : TMGExtArray =
     237   (  (Signature : FN_BEGIN_SIGNATURE;
     238       SigLen    : FN_BEGIN_SIGNATURE_LEN;
     239       EndTag    : FN_END_TAG),
     240
     241      (Signature : FLD_OBJ_SIGNATURE;
     242       SigLen    : FLD_OBJ_SIG_LEN;
     243       EndTag    : FLD_OBJ_END_TAG)
     244   );
     245
     246
    200247  //MissingFieldsTxt = 'One or more required fields must still be entered.';  <-- original line.  //kt 8/8/2007
    201248  function MissingFieldsTxt : string;  //kt added
    … …  
    289336uses
    290337  ORFn, rTemplates, ORCtrls, mTemplateFieldButton, dShared, uConst, uCore, rCore, Windows,
     338  ORNet,  //kt
     339  TRPCB, //kt
    291340  DKLang; //kt
    292341
    … …  
    296345  TemplateFieldSignatureEndLen = length(TemplateFieldEndSignature);
    297346
    298 
    299347var
    300348  uTmplFlds: TList = nil;
    … …  
    305353
    306354  uInternalFieldIDCount: integer = 0;
     355  uInternalFormulaCount: integer = 0;  //kt
     356  uInternalTxtObjCount : integer = 0; //kt
    307357
    308358const
    … …  
    416466    if(uEntries.Count = 0) then
    417467      uInternalFieldIDCount := 0;
    418   end;
    419 end;
    420 
    421 procedure AssignFieldIDs(var Txt: string);
     468      uInternalFormulaCount := 0; //kt
     469      uInternalTxtObjCount := 0; //kt
     470  end;
     471end;
     472
     473//kt original line --> procedure AssignFieldIDs(var Txt: string);
     474procedure AssignFieldIDs(var Txt: string; NameToObjID : TStringList); //kt
    422475var
    423476  i: integer;
     477  p2 : integer; //kt
     478  FldName : string; //kt
     479  FldID : string; //kt
    424480
    425481begin
    426482  i := 0;
    427   while (i < length(Txt)) do
    428   begin
     483  while (i < length(Txt)) do begin
    429484    inc(i);
    430     if(copy(Txt,i,TemplateFieldSignatureLen) = TemplateFieldBeginSignature) then
    431     begin
     485    if copy(Txt,i,TemplateFieldSignatureLen) = TemplateFieldBeginSignature then begin
    432486      inc(i,TemplateFieldSignatureLen);
    433       if(i < length(Txt)) and (copy(Txt,i,1) <> FieldIDDelim) then
    434       begin
     487      if(i < length(Txt)) and (copy(Txt,i,1) <> FieldIDDelim) then begin
     488        p2 := PosEx(TemplateFieldEndSignature,Txt,i);           //kt
     489        FldName := '';                                          //kt
     490        if p2 > 0 then FldName := Trim(copy(Txt,i,(p2-i)));  //kt
    435491        insert(GetNewFieldID, Txt, i);
    436492        inc(i, FieldIDLen);
    437       end;
    438     end;
    439   end;
    440 end;
    441 
    442 procedure AssignFieldIDs(SL: TStrings);
     493        if (FldName <> '') and Assigned(NameToObjID) then begin                                      //kt
     494          NameToObjID.AddObject(FldName,Pointer(uInternalFieldIDCount)); //kt
     495        end;                                                             //kt
     496      end;
     497    end;
     498  end;
     499end;
     500
     501procedure AssignFieldIDs(SL: TStrings; NameToObjID : TStringList);
    443502var
    444503  i: integer;
    … …  
    449508  begin
    450509    txt := SL[i];
    451     AssignFieldIDs(txt);
     510    //kt AssignFieldIDs(txt);
     511    AssignFieldIDs(txt, NameToObjID); //kt
    452512    SL[i] := txt;
    453513  end;
    454514end;
     515
     516function CloseCharPos(OpenChar, CloseChar : char; var Txt : string; StartingPos : integer=1) : integer;
     517//kt added function
     518//Return the position of a closing character, ignoring all intervening nested open and close chars
     519//NOTE: It is expected that StartingPos is pointing to the first opening character.
     520var i : integer;
     521    CloseMatchesNeeded : integer;
     522begin
     523  Result := 0;
     524  CloseMatchesNeeded := 1;
     525  for i := StartingPos to Length(Txt) do begin
     526    if (Txt[i] = OpenChar) and (i <> StartingPos) then Inc(CloseMatchesNeeded);
     527    if Txt[i] = CloseChar then Dec(CloseMatchesNeeded);
     528    if CloseMatchesNeeded = 0 then begin
     529      Result := i;
     530      break;
     531    end;
     532  end;
     533end;
     534
     535
     536procedure HideFormulas(SL : TStrings; Formulas : TStringList);
     537//kt added function
     538//NOTE: formulas will not be allowed to use the '}' character
     539var p1,p2 : integer;
     540    FnStr : string;
     541    SubStrA,SubStrB : string;
     542    Txt : String;
     543begin
     544  Txt := SL.Text;
     545  p1 := Pos(FN_BEGIN_SIGNATURE,Txt);
     546  while (p1>0) do begin
     547    SubStrA := MidStr(Txt,1,p1-1);
     548    p1 := p1 + FN_BEGIN_SIGNATURE_LEN;
     549    //p2 := PosEx(FN_END_TAG,Txt,p1);
     550    p2 := CloseCharPos(FN_BEGIN_TAG, FN_END_TAG, Txt, p1);
     551    SubStrB := MidStr(Txt,p2+1,999);
     552    FnStr := MidStr(Txt,p1, (p2-p1));
     553    FnStr := AnsiReplaceText(FnStr,#9,'');
     554    FnStr := AnsiReplaceText(FnStr,#10,'');
     555    FnStr := AnsiReplaceText(FnStr,#13,'');
     556    //FnStr := AnsiReplaceText(FnStr,' ','');
     557    inc(uInternalFormulaCount);
     558    Formulas.AddObject(FnStr,Pointer(uInternalFormulaCount));
     559    Txt := SubStrA + FN_SHOW_TEXT + IntToStr(uInternalFormulaCount) + FN_SHOW_TEXT_END + SubStrB;
     560    p1 := PosEx(FN_BEGIN_SIGNATURE,Txt,p1);
     561  end;
     562  SL.Text := Txt;
     563end;
     564
     565procedure HideTxtObjects(SL : TStrings; TxtObjects : TStringList); //kt added 3/28/10
     566//kt added function
     567var p1,p2 : integer;
     568    FnStr : string;
     569    SubStrA,SubStrB : string;
     570    Txt : String;
     571begin
     572  Txt := SL.Text;
     573  p1 := Pos(FLD_OBJ_SIGNATURE,Txt);
     574  while (p1>0) do begin
     575    SubStrA := MidStr(Txt,1,p1-1);
     576    p1 := p1 + FN_OBJ_TAG_LEN;
     577    p2 := CloseCharPos(FN_BEGIN_TAG, FN_END_TAG, Txt, p1);
     578    SubStrB := MidStr(Txt,p2+1,999);
     579    FnStr := MidStr(Txt,p1, (p2-p1));
     580    FnStr := AnsiReplaceText(FnStr,#9,'');
     581    FnStr := AnsiReplaceText(FnStr,#10,'');
     582    FnStr := AnsiReplaceText(FnStr,#13,'');
     583    inc(uInternalTxtObjCount);
     584    TxtObjects.AddObject(FnStr,Pointer(uInternalTxtObjCount));
     585    Txt := SubStrA + OBJ_SHOW_TEXT + IntToStr(uInternalTxtObjCount) + OBJ_SHOW_TEXT_END + SubStrB;
     586    p1 := PosEx(FLD_OBJ_SIGNATURE,Txt,p1);
     587  end;
     588  SL.Text := Txt;
     589end;
     590
     591function InsideMarkers(var S : string; MarkerCh : char; P : integer) : boolean;
     592//Function returns if position P is inside characters MarkerCh.
     593//e.g. S =  'xxx|xxxxx|xxxxx'  MarkerCh='|'
     594//     P = 2  ==> result is false
     595//     P = 5  ==> result is true
     596//     P = 12 ==> result is false
     597
     598var p1,p2 : integer;
     599    Inside : boolean;
     600begin
     601  Inside := false;
     602  p1 := Pos(MarkerCh,S);
     603  while (p1 > 0) do begin
     604    if (p1 >= P) then break;
     605    p1 := PosEx(MarkerCh,S,p1+1);
     606    if (p1 > 0) and (p1 > P) then Inside := not Inside;
     607  end;
     608  Result := Inside;
     609end;
     610
     611function SubstuteIDs(Txt : string; NameToObjID : TStringList) : string;
     612//kt added function
     613//Prefix any field names with their FldID's, in format of FieldIDDelim+FldID
     614// E.g. [FLD:1:NUM1-16] --> `00001NUM1-16`
     615//Note: Field ID's are started with character FieldIDDelim, and are of a fixed length (FieldIDLen)
     616
     617(*  Syntax examples:
     618
     619 {FN:[FLD:1:NUMB1-16]-[FLD:2:NUMB1-16]-[FLD:3:NUMB1-16]}, or
     620 {FN:[OBJ:TABLE1]-[FLD:2:NUMB1-16]-[FLD:3:NUMB1-16]}, or
     621 {FN:[OBJ:TABLE2("POTASSIUM")]-[FLD:2:NUMB1-16]-[FLD:3:NUMB1-16]}, or
     622 {FN:[OBJ:TABLE2([FLD:1:NUMB1-16])]-[FLD:2:NUMB1-16]-[FLD:3:NUMB1-16]}
     623 {FN:[OBJ:TABLE2((5+3)/2)]-[FLD:2:NUMB1-16]-[FLD:3:NUMB1-16]}
     624 (arbitrary deep nesting)
     625 Note: arguments should be round by matching [ ]'s
     626       An argument will start with a TYPE (so far, FLD or OBJ) and ':'
     627
     628       If TYPE is FLD, there will be :number:, with number being same
     629       as number in old format (i.e. ...]#2).
     630       If number not provided, then default value is 1
     631
     632       If TYPE is OBJ, then this indicates that the parameter name (e.g. TABLE) is
     633       the name of a TIU TEXT object, that will be processed on the server.
     634       Parameters should be resolved before passing to the server.
     635*)
     636
     637var i,j,p1,p2 : integer;
     638    SubStrA,SubStrB, NumStr : string;
     639    FldIDNum,CountofSimilar : integer;
     640    FldIDNumStr : string;
     641    CountOfSimStr : string;
     642    Temp,FldName : string;
     643    Skip : boolean;
     644begin
     645  for i := 0 to NameToObjID.Count-1 do begin
     646    CountofSimilar := 0;
     647    FldName := NameToObjID.Strings[i];
     648    for j := 0 to i do begin
     649      if NameToObjID.Strings[i] = FldName then inc(CountofSimilar);
     650    end;
     651    CountOfSimStr := IntToStr(CountofSimilar);
     652    FldIDNum := Integer(NameToObjID.Objects[i]);
     653    FldIDNumStr := IntToStr(FldIDNum);
     654    FldIDNumStr := FieldIDDelim + StringOfChar('0', FieldIDLen-1-Length(FldIDNumStr)) + FldIDNumStr;
     655    p1 := 1;
     656    p1 := PosEx(FldName,Txt,p1);
     657    while InsideMarkers(Txt, FieldIDDelim, p1) do begin //Ignore included fieldnames from prior cycle.
     658      p2 := PosEx(FieldIDDelim,Txt,p1+1);
     659      if p2 >0 then begin
     660         p1 := p2+1;
     661         p1 := PosEx(FldName,Txt,p1);
     662      end else p1 := 999;  //error condition.
     663    end;
     664    while (p1>0) and (p1 < 999) do begin
     665      Skip := false;
     666      SubStrA := MidStr(Txt,1,p1-1);
     667      SubStrB := MidStr(Txt, p1+Length(FldName), 999);
     668      if (LeftStr(SubStrB,1)=']') and (Pos(FN_FIELD_TAG,SubStrA) > 0) then begin
     669        NumStr := piece(RightStr(SubStrA,7),':',2);
     670        SubStrA := LeftStr(SubStrA,Length(SubStrA)-7);
     671        p2 := 2;
     672        SubStrB := MidStr(SubStrB,p2,999);
     673        if NumStr <> CountOfSimStr then begin
     674          Skip := true;
     675          Inc(p1);
     676        end;
     677      end else begin
     678         Skip := true;
     679         Inc(p1);
     680      end;
     681      if not Skip then begin
     682        Txt := SubStrA + FldIDNumStr +FldName + FieldIDDelim;
     683        p1 := Length(Txt);
     684        Txt := Txt + SubStrB;
     685      end;
     686      p1 := PosEx(FldName,Txt,p1);
     687    end;
     688  end;
     689  Result := Txt;
     690end;
     691
     692
     693function RestoreTransformFormulas(SL : TStrings; Formulas, NameToObjID : TStringList) : boolean;
     694//kt added 3/26/10
     695//Returns if any changes made
     696//Replace formula text back in, and change field names into FldID's
     697
     698  function GetFormula(NumStr : string) : string;
     699  //Return formula text based on provided index number of formula
     700  var num, i : integer;
     701      PtrNum : Pointer;
     702  begin
     703    Result := '';
     704    try
     705      Num := StrToInt(NumStr);
     706      PtrNum := Pointer(Num);
     707      for i := 0 to Formulas.Count-1 do begin
     708        if Formulas.Objects[i] = PtrNum then begin
     709          Result := Formulas.Strings[i];
     710          break;
     711        end;
     712      end;
     713    except
     714      on EConvertError do Result := '??';
     715    end;
     716  end;
     717
     718var p1,p2 : integer;
     719    count : integer;
     720    FnStr : string;
     721    Txt : string;
     722    SubStrA,SubStrB : string;
     723begin
     724  Txt := SL.Text;
     725  Result := false;
     726  p1 := Pos(FN_SHOW_TEXT,Txt);
     727  while (p1>0) do begin
     728    SubStrA := MidStr(Txt,1,p1-1);
     729    p1 := p1 + FN_SHOW_TEXT_LEN;
     730    p2 := PosEx(FN_SHOW_TEXT_END,Txt,p1);
     731    SubStrB := MidStr(Txt,p2+1,999);
     732    FnStr := MidStr(Txt,p1, (p2-p1));
     733    FnStr := GetFormula(FnStr);
     734    FnStr := SubstuteIDs(FnStr,NameToObjID);
     735    Txt := SubStrA + FN_BEGIN_SIGNATURE + FnStr + FN_END_TAG + SubStrB;
     736    Result := true;
     737    p1 := PosEx(FN_SHOW_TEXT,Txt,p1);
     738  end;
     739  SL.Text := Txt;
     740end;
     741
     742{
     743function RestoreTransformFormulas(SL : TStrings; Formulas, NameToObjID : TStringList) : boolean; overload;
     744//kt added 3/26/10
     745//Returns if any changes made
     746var
     747  i: integer;
     748  Changed : boolean;
     749  txt: string;
     750
     751begin
     752  Result := false;
     753  for i := 0 to SL.Count-1 do begin
     754    txt := SL[i];
     755    Changed := RestoreTransformFormulas(txt, Formulas, NameToObjID);
     756    Result := Result or Changed;
     757    SL[i] := txt;
     758  end;
     759end;
     760}
     761
     762function RestoreTransformTxtObjects(SL : TStrings; TxtObjects, NameToObjID : TStringList) : boolean;
     763//kt added 3/28/10
     764//Returns if any changes made
     765//Replace formula text back in, and change field names into FldID's
     766
     767  function GetTxtObjects(NumStr : string) : string;
     768  //Return TxtObject text based on provided index number of formula
     769  var num, i : integer;
     770      PtrNum : Pointer;
     771  begin
     772    Result := '';
     773    try
     774      Num := StrToInt(NumStr);
     775      PtrNum := Pointer(Num);
     776      for i := 0 to TxtObjects.Count-1 do begin
     777        if TxtObjects.Objects[i] = PtrNum then begin
     778          Result := TxtObjects.Strings[i];
     779          break;
     780        end;
     781      end;
     782    except
     783      on EConvertError do Result := '??';
     784    end;
     785  end;
     786
     787var p1,p2 : integer;
     788    count : integer;
     789    ObjStr : string;
     790    SubStrA,SubStrB : string;
     791    Txt : string;
     792begin
     793  Txt := SL.Text;
     794  Result := false;
     795  p1 := Pos(OBJ_SHOW_TEXT,Txt);
     796  while (p1>0) do begin
     797    SubStrA := MidStr(Txt,1,p1-1);
     798    p1 := p1 + OBJ_SHOW_TEXT_LEN;
     799    p2 := PosEx(OBJ_SHOW_TEXT_END,Txt,p1);
     800    SubStrB := MidStr(Txt,p2+1,999);
     801    ObjStr := MidStr(Txt,p1, (p2-p1));
     802    ObjStr := GetTxtObjects(ObjStr);
     803    ObjStr := SubstuteIDs(ObjStr,NameToObjID);
     804    Txt := SubStrA + FLD_OBJ_SIGNATURE + ObjStr + FLD_OBJ_END_TAG + SubStrB;
     805    Result := true;
     806    p1 := PosEx(OBJ_SHOW_TEXT,Txt,p1);
     807  end;
     808  SL.Text := Txt;
     809end;
     810
     811
     812function GetRPCTIUObj(TIUObjName : string) : string;
     813//kt added entire function 3/28/10
     814//Based on rTemplates.GetTemplateText(BoilerPlate: TStrings);
     815begin
     816  TIUObjName := AnsiReplaceText(TIUObjName,'|','');
     817  with RPCBrokerV do begin
     818    ClearParameters := True;
     819    RemoteProcedure := 'TIU TEMPLATE GETTEXT';
     820    Param[0].PType := literal;
     821    Param[0].Value := Patient.DFN;
     822    Param[1].PType := literal;
     823    Param[1].Value := Encounter.VisitStr;
     824    Param[2].PType := list;
     825    Param[2].Mult[IntToStr(1)+',0'] := '|' + TIUObjName + '|';
     826    CallBroker;
     827    RPCBrokerV.Results.Delete(0);
     828    if RPCBrokerV.Results.count > 0 then begin
     829      Result := RPCBrokerV.Results.Strings[0];
     830    end else Result := '';
     831    RPCBrokerV.Results.Clear;
     832  end;
     833end;
     834
     835
     836Procedure EvalTIUObjects(var Formula : string);
     837//kt added entire function 3/28/10
     838var p1,p2 : integer;
     839    OP1,OP2 : integer;
     840    Problem : boolean;
     841    SubStrA, SubStrB : string;
     842    TIUObj,Argument,s : string;
     843begin
     844  p1 := Pos(FN_OBJ_TAG, Formula);
     845  while (p1 > 0) do begin
     846    p2 := CloseCharPos('[',']',Formula, p1+1);
     847    if p2=0 then begin
     848      Formula := 'ERROR.  Matching "]" not found after ' + FN_OBJ_TAG + '.';
     849      Exit;
     850    end;
     851    SubStrA := MidStr(Formula,1,p1-1);
     852    p1 := p1+FN_OBJ_TAG_LEN;
     853    TIUObj := Trim(MidStr(Formula, p1, (p2-p1)));
     854    SubStrB := MidStr(Formula,p2+1,999);
     855    OP1 := Pos('{',TIUObj);
     856    if (OP1 > 0) then begin
     857      OP2 := CloseCharPos('{','}', TIUObj, OP1+1);
     858      if OP2=0 then begin
     859        Formula := 'ERROR.  Matching ")" not found after "(".';
     860        Exit;
     861      end;
     862      Argument := MidStr(TIUObj,OP1+1,(OP2-(OP1+1)));
     863      if Pos(FN_OBJ_TAG,Argument)>0 then begin
     864        EvalTIUObjects(Argument)
     865      end;
     866      Problem := false;
     867      s := FloatToStr(StringEval(Argument,Problem));
     868      if Problem then begin
     869        Formula := 'ERROR evaluating argument: [' + s + '].';
     870        Exit;
     871      end else begin
     872        Argument := s;
     873      end;
     874      TIUObj := MidStr(TIUObj,1,OP1-1) + '{' + Argument + '}';
     875    end;
     876    TIUObj := GetRPCTIUObj(TIUObj);
     877    Formula := SubStrA + TIUObj + SubStrB;
     878    p1 := Pos(FN_OBJ_TAG, Formula);
     879  end;
     880end;
     881
     882
    455883
    456884procedure WordWrapText(var Txt: string; HTMLMode : boolean);
    … …  
    561989  Entry: TTemplateDialogEntry;
    562990  iField, Temp, NewTxt, Fld: string;
    563   FoundEntry: boolean;
     991  FoundEntry,Problem: boolean;
    564992  TmplFld: TTemplateField;
    565993  tempSL : TStringList;
     994  SubStrA, SubStrB : string;  //kt
     995  ExtMode : TMGExtension; //kt
     996  TempStr, FnObjStr,Argument : string; //kt
     997  FnP1,FnP2,p1,p2 : integer; //kt
    566998
    567999  procedure AddNewTxt;
    … …  
    6481080    end;
    6491081  until(i = 0);
     1082
     1083  //kt -- begin mod ---  Entire section added.
     1084  Temp := Result;
     1085  for ExtMode := tmgeFN to tmgeOBJ do begin
     1086    repeat
     1087      i := pos(TMG_MATCH[ExtMode].Signature, Temp);
     1088      if(i > 0) then begin
     1089        FnP1 := i;
     1090        FnP2 := CloseCharPos('{', TMG_MATCH[ExtMode].EndTag, Temp, i);
     1091        //FnP2 := Pos(TMG_MATCH[ExtMode].EndTag,Temp);    //Should use CloseCharPos function
     1092        p1 := FnP1 + TMG_MATCH[ExtMode].SigLen;
     1093        FnObjStr := MidStr(Temp, p1, FnP2-p1);
     1094        p1 := Pos(FieldIDDelim,FnObjStr);
     1095        while (p1 > 0) do begin
     1096          SubStrA := MidStr(FnObjStr,1,p1-1);
     1097          p2 := PosEx(FieldIDDelim,FnObjStr,p1+1);
     1098          Argument := MidStr(FnObjStr,p1+1,(p2-p1)-1);
     1099          SubStrB := MidStr(FnObjStr,p2+1,999);
     1100          CtrlID := StrToIntDef(MidStr(Argument,1,FieldIDLen-1), 0);
     1101          Fld := MidStr(Argument,FieldIDLen,999);
     1102          if(CtrlID > 0) then begin
     1103            FoundEntry := FALSE;
     1104            for j := 0 to uEntries.Count-1 do begin
     1105              Entry := TTemplateDialogEntry(uEntries.Objects[j]);
     1106              if(assigned(Entry)) then begin
     1107                if IncludeEmbedded then
     1108                  iField := Fld
     1109                else
     1110                  iField := '';
     1111                NewTxt := Entry.GetControlText(CtrlID, FALSE, FoundEntry, AutoWrap, iField);
     1112                TmplFld := GetTemplateField(Fld, FALSE);
     1113                if (assigned(TmplFld)) and (TmplFld.DateType in DateComboTypes) then {if this is a TORDateBox}
     1114                   NewTxt := Piece(NewTxt,':',1);          {we only want the first piece of NewTxt}
     1115                Argument := Trim(NewTxt);
     1116              end;
     1117            end;
     1118          end else Argument := '??';
     1119          FnObjStr := SubStrA + Argument + SubStrB;
     1120          p1 := Pos(FieldIDDelim,FnObjStr);
     1121        end;
     1122        if (ExtMode = tmgeOBJ) then begin
     1123          FnObjStr := FN_OBJ_TAG + FnObjStr + ']';
     1124        end;
     1125        if (Pos(FN_OBJ_TAG,FnObjStr)>0) then begin
     1126          EvalTIUObjects(FnObjStr);
     1127        end;
     1128        if ExtMode = tmgeFN then begin
     1129          Problem := false;
     1130          TempStr := AnsiReplaceText(FnObjStr,' ','');
     1131          TempStr := FloatToStr(StringEval(TempStr,Problem));
     1132          if not Problem then FnObjStr := TempStr;
     1133        end;
     1134        SubStrA := MidStr(Temp,1,FnP1-1);
     1135        SubStrB := MidStr(Temp,FnP2+1,999);
     1136        if (HTMLMode=true) and (FnObjStr <> '') then begin
     1137          FnObjStr := HTMLAnswerOpenTag + FnObjStr + HTMLAnswerCloseTag;
     1138        end;
     1139        Temp := SubStrA + FnObjStr + SubStrB;
     1140      end else begin
     1141        if HTMLMode=true then begin
     1142          tempSL := TStringList.create;
     1143          tempSL.Text := Result;
     1144          if tempSL.Count < 3 then begin
     1145            Result := HTMLAnswerOpenTag + Result + HTMLAnswerCloseTag;
     1146          end;
     1147          tempSL.Free;
     1148        end;
     1149      end;
     1150    until(i = 0);
     1151  end;
     1152  Result := Temp;
     1153  //kt -- end mod --
     1154
    6501155  if not AutoWrap then
    6511156    WordWrapText(Result,HTMLMode);
    … …  
    6601165  Temp, NewTxt, FldName: string;
    6611166  FoundEntry: boolean;
     1167  SubStrA,SubStrB : string;
    6621168
    6631169begin
    … …  
    25103016end;
    25113017
     3018function EvaluateFormula(formula : string): string;
     3019begin
     3020//CloseCharPos(OpenChar, CloseChar : char; var Txt : string; StartingPos : integer=1) : integer;
     3021end;
     3022
    25123023initialization
    25133024
Note: See TracChangeset for help on using the changeset viewer.