- Timestamp:
- Mar 31, 2010, 5:06:56 PM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
cprs/branches/tmg-cprs/CPRS-Chart/Templates/uTemplateFields.pas
r694 r729 6 6 uses 7 7 Forms, SysUtils, StrUtils, Classes, Dialogs, StdCtrls, ExtCtrls, Controls, Contnrs, 8 Graphics, ORClasses, ComCtrls, ORDtTm ;8 Graphics, ORClasses, ComCtrls, ORDtTm, uEvaluate; 9 9 10 10 type … … 166 166 function GetDialogEntry(AParent: TWinControl; AID, AText: string): TTemplateDialogEntry; 167 167 procedure 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; 169 procedure AssignFieldIDs(var Txt: string; NameToObjID : TStringList=nil); overload; //kt 3/26/10 170 //kt 3/26/10 --> original procedure AssignFieldIDs(SL: TStrings); overload; 171 procedure AssignFieldIDs(SL: TStrings; NameToObjID : TStringList=nil); overload; //kt 3/26/10 172 procedure HideFormulas(SL : TStrings; Formulas : TStringList); //kt added 3/26/10 173 procedure 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 175 function RestoreTransformFormulas(SL : TStrings; Formulas, NameToObjID : TStringList) : boolean; {overload; }//kt added 3/26/10 170 176 //kt 12/28/09 originial --> function ResolveTemplateFields(Text: string; AutoWrap: boolean; Hidden: boolean = FALSE; IncludeEmbedded: boolean = FALSE): string; 177 function RestoreTransformTxtObjects(SL : TStrings; TxtObjects, NameToObjID : TStringList) : boolean; 171 178 function ResolveTemplateFields(Text: string; 172 179 AutoWrap: boolean; … … 190 197 procedure ConvertCodes2Text(sl: TStrings; Short: boolean); 191 198 function StripEmbedded(iItems: string): string; 199 function CloseCharPos(OpenChar, CloseChar : char; var Txt : string; StartingPos : integer=1) : integer; //kt added 200 201 type 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; 192 209 193 210 const 194 211 TemplateFieldBeginSignature = '{FLD:'; 195 212 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 200 247 //MissingFieldsTxt = 'One or more required fields must still be entered.'; <-- original line. //kt 8/8/2007 201 248 function MissingFieldsTxt : string; //kt added … … 289 336 uses 290 337 ORFn, rTemplates, ORCtrls, mTemplateFieldButton, dShared, uConst, uCore, rCore, Windows, 338 ORNet, //kt 339 TRPCB, //kt 291 340 DKLang; //kt 292 341 … … 296 345 TemplateFieldSignatureEndLen = length(TemplateFieldEndSignature); 297 346 298 299 347 var 300 348 uTmplFlds: TList = nil; … … 305 353 306 354 uInternalFieldIDCount: integer = 0; 355 uInternalFormulaCount: integer = 0; //kt 356 uInternalTxtObjCount : integer = 0; //kt 307 357 308 358 const … … 416 466 if(uEntries.Count = 0) then 417 467 uInternalFieldIDCount := 0; 418 end; 419 end; 420 421 procedure AssignFieldIDs(var Txt: string); 468 uInternalFormulaCount := 0; //kt 469 uInternalTxtObjCount := 0; //kt 470 end; 471 end; 472 473 //kt original line --> procedure AssignFieldIDs(var Txt: string); 474 procedure AssignFieldIDs(var Txt: string; NameToObjID : TStringList); //kt 422 475 var 423 476 i: integer; 477 p2 : integer; //kt 478 FldName : string; //kt 479 FldID : string; //kt 424 480 425 481 begin 426 482 i := 0; 427 while (i < length(Txt)) do 428 begin 483 while (i < length(Txt)) do begin 429 484 inc(i); 430 if(copy(Txt,i,TemplateFieldSignatureLen) = TemplateFieldBeginSignature) then 431 begin 485 if copy(Txt,i,TemplateFieldSignatureLen) = TemplateFieldBeginSignature then begin 432 486 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 435 491 insert(GetNewFieldID, Txt, i); 436 492 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; 499 end; 500 501 procedure AssignFieldIDs(SL: TStrings; NameToObjID : TStringList); 443 502 var 444 503 i: integer; … … 449 508 begin 450 509 txt := SL[i]; 451 AssignFieldIDs(txt); 510 //kt AssignFieldIDs(txt); 511 AssignFieldIDs(txt, NameToObjID); //kt 452 512 SL[i] := txt; 453 513 end; 454 514 end; 515 516 function 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. 520 var i : integer; 521 CloseMatchesNeeded : integer; 522 begin 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; 533 end; 534 535 536 procedure HideFormulas(SL : TStrings; Formulas : TStringList); 537 //kt added function 538 //NOTE: formulas will not be allowed to use the '}' character 539 var p1,p2 : integer; 540 FnStr : string; 541 SubStrA,SubStrB : string; 542 Txt : String; 543 begin 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; 563 end; 564 565 procedure HideTxtObjects(SL : TStrings; TxtObjects : TStringList); //kt added 3/28/10 566 //kt added function 567 var p1,p2 : integer; 568 FnStr : string; 569 SubStrA,SubStrB : string; 570 Txt : String; 571 begin 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; 589 end; 590 591 function 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 598 var p1,p2 : integer; 599 Inside : boolean; 600 begin 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; 609 end; 610 611 function 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 637 var 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; 644 begin 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; 690 end; 691 692 693 function 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 718 var p1,p2 : integer; 719 count : integer; 720 FnStr : string; 721 Txt : string; 722 SubStrA,SubStrB : string; 723 begin 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; 740 end; 741 742 { 743 function RestoreTransformFormulas(SL : TStrings; Formulas, NameToObjID : TStringList) : boolean; overload; 744 //kt added 3/26/10 745 //Returns if any changes made 746 var 747 i: integer; 748 Changed : boolean; 749 txt: string; 750 751 begin 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; 759 end; 760 } 761 762 function 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 787 var p1,p2 : integer; 788 count : integer; 789 ObjStr : string; 790 SubStrA,SubStrB : string; 791 Txt : string; 792 begin 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; 809 end; 810 811 812 function GetRPCTIUObj(TIUObjName : string) : string; 813 //kt added entire function 3/28/10 814 //Based on rTemplates.GetTemplateText(BoilerPlate: TStrings); 815 begin 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; 833 end; 834 835 836 Procedure EvalTIUObjects(var Formula : string); 837 //kt added entire function 3/28/10 838 var p1,p2 : integer; 839 OP1,OP2 : integer; 840 Problem : boolean; 841 SubStrA, SubStrB : string; 842 TIUObj,Argument,s : string; 843 begin 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; 880 end; 881 882 455 883 456 884 procedure WordWrapText(var Txt: string; HTMLMode : boolean); … … 561 989 Entry: TTemplateDialogEntry; 562 990 iField, Temp, NewTxt, Fld: string; 563 FoundEntry : boolean;991 FoundEntry,Problem: boolean; 564 992 TmplFld: TTemplateField; 565 993 tempSL : TStringList; 994 SubStrA, SubStrB : string; //kt 995 ExtMode : TMGExtension; //kt 996 TempStr, FnObjStr,Argument : string; //kt 997 FnP1,FnP2,p1,p2 : integer; //kt 566 998 567 999 procedure AddNewTxt; … … 648 1080 end; 649 1081 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 650 1155 if not AutoWrap then 651 1156 WordWrapText(Result,HTMLMode); … … 660 1165 Temp, NewTxt, FldName: string; 661 1166 FoundEntry: boolean; 1167 SubStrA,SubStrB : string; 662 1168 663 1169 begin … … 2510 3016 end; 2511 3017 3018 function EvaluateFormula(formula : string): string; 3019 begin 3020 //CloseCharPos(OpenChar, CloseChar : char; var Txt : string; StartingPos : integer=1) : integer; 3021 end; 3022 2512 3023 initialization 2513 3024
Note:
See TracChangeset
for help on using the changeset viewer.