source: cprs/branches/tmg-cprs/CPRS-Chart/rHTMLTools.pas@ 454

unit rHTMLTools;
(*
  This entire unit was created by K. Toppenberg, starting on 5/27/05
  It will hold additional functions to support HTML display of notes
  and printing of HTML notes.
*)

interface

uses Windows, SysUtils, Classes, Printers, ComCtrls,
     ShDocVw, {//kt added ShDocVw 5-2-05 for TWebBrowser access}
     ORFn;    {//kt for RedrawActivate}

procedure PrintHTMLReport(Lines: TStringList; var ErrMsg: string);  //kt added 5-2-05
function IsHTMLDocument(Lines : TStrings): boolean;  //kt added 5-2-05
procedure WaitForBrowserOK(MaxSecDelay: integer);
procedure ActivateWebBrowser;
procedure ActivateMemo;
function CheckForImageLink(Lines: TStrings; ImageList : TStringList) : boolean;

implementation

uses fNotes,
     fImages,
     StrUtils; {//kt added 5-2-05 rTIU for frmNotes.WebBrowser access}


procedure PrintHTMLReport(Lines: TStringList; var ErrMsg: string);
//Note:
//     I use two web browsers because sometimes the display web browser
//     would be changed by other parts of CPRS during the printing
//     process, causing the incorrect page to print out.  By having a
//     browser just for printing, this will hopefully not happen.
//
//      Web browser printing options:
//        OLECMDEXECOPT_DODEFAULT       Use the default behavior, whether prompting the user for input or not.
//        OLECMDEXECOPT_PROMPTUSER      Execute the command after obtaining user input.
//        OLECMDEXECOPT_DONTPROMPTUSER  Execute the command without prompting the user.

var
  Status: OLECMDF;
  HTMLfilename : string;
  //Pauses : integer;
begin
  try
    begin
      HTMLfilename := ExtractFilePath(ParamStr(0)) + 'printing_html_note.html';
      Lines.SaveToFile(HTMLfilename);  //write the note to a file,
      frmNotes.WebBrowser1.Navigate(HTMLfilename);  //now navigate to file.
      ActivateWebBrowser;
      Status := frmNotes.WebBrowser1.QueryStatusWB(OLECMDID_PRINT);  //"can you print?" -- get print command status
      //Note: If I print multiple documents, I think there may be a problem if
      //      document #2 asks to print, and it is not yet done with doc #1
      //      As it is now, it will simply report an error.  Solutions would
      //      be to wait a certain period of time and then ask for status again.
      //      OR, I could wait after printing until it is done....
      WaitForBrowserOK(10); //wait up to 10 seconds
      if (Status and OLECMDF_ENABLED)>0 then begin
        frmNotes.WebBrowser1.ExecWB(OLECMDID_PRINT,OLECMDEXECOPT_PROMPTUSER);
        //Here I want to wait until it is done printing.
        //Note: this doesn't do what I want.  Status is immediately OK.
        WaitForBrowserOK(10); //wait up to 10 seconds
      end else begin
        ErrMsg := 'The web browser reports being unable to print.  Trying printing this document by itself.';
      end;
    end;
  finally
    begin
      //any needed final code goes here.
    end;
  end;
end;


procedure WaitForBrowserOK(MaxSecDelay: integer);
var
  CumulativeDelay : integer;
  Status: OLECMDF;
  MaxMSDelay: integer;

const
  DelayStep = 1000;
begin
  MaxMSDelay:=MaxSecDelay*1000;
  CumulativeDelay := 0;
  while ((Status and OLECMDF_ENABLED)<=0) and (CumulativeDelay < MaxMSDelay) do begin
    sleep(DelayStep);
    CumulativeDelay := CumulativeDelay + DelayStep;
    Status := frmNotes.WebBrowser1.QueryStatusWB(OLECMDID_PRINT);  //"can you print?" -- get print command status
    //Beep;
  end;
end;


Procedure ScanForSubs(Lines : TStrings);
//Purpose: To scan note for constant $CPRS$ and replace with CPRS's actual directory
var i : integer;
    CPRSDir : string;
begin
  for i := 0 to Lines.Count-1 do begin
    if Pos('$CPRSDIR$',Lines.Strings[i])>0 then begin
      CPRSDir := ExcludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)));
      Lines.Strings[i] := AnsiReplaceStr(Lines.Strings[i],'$CPRSDIR$',CPRSDir);
      //Ensure images are downloaded before passing page to web browser        
      frmImages.timLoadImagesTimer(nil);  //only downloads 1 image each call
    end;
  end;
end;


//kt added following 5-2-05
function IsHTMLDocument(Lines : TStrings): boolean;
{purpose: To look at the note loaded into Lines and determine if it is
          an HTML document.
 Test used: if document contains <!DOCTYPE HTML" or <HTML>
      This is not a fool-proof test...                                   }
var
  i:integer;  s : string;
begin
  i := 0;
  Result := false;  //default of false
  while (i <= Lines.Count-1) do begin
    s := UpperCase(Lines.Strings[i]);
    if (Pos('<!DOCTYPE HTML',s) > 0) or (Pos('<HTML>',s) > 0) then begin
      Result := true;
      break;
    end;
    Inc(i);
  end;
  if Result = true then ScanForSubs(Lines);  
end;
//kt end of addition from 5-2-05


procedure ActivateWebBrowser;
begin
  with frmNotes do begin
    MemNote.Lines.SaveToFile(HTMLfilename);  //write the note to a file,
    //kt I later delete the file on destruction of this form (on CPRS exiting)
    WebBrowser1.Visible := true;
    WebBrowser1.TabStop := true;
    WebBrowser1.Navigate(HTMLfilename);  //now navigate to file.
    WebBrowser1.BringToFront;
    memNote.Visible := false;
    memNote.TabStop := false;
  end;
end;

procedure ActivateMemo;
begin
  with frmNotes do begin
    WebBrowser1.Visible := false;
    //WebBrowser1.Navigate('about:blank');  //if I leave this here, "Print Selected" doesn't work properly
    //DeleteFile(HTMLfilename);  //no error if file doesn't exist.
    WebBrowser1.TabStop := false;
    memNote.Visible := true;
    memNote.TabStop := true;
    memNote.BringToFront;
    RedrawActivate(frmNotes.memNote.Handle);
  end;
end;



//kt added the following  1/1/05
function CheckForImageLink(Lines: TStrings; ImageList : TStringList) : boolean;
{Purpose:  To scan memNote memo for a link to an image.  If found, return link(s)
 input:  none:
 output:  Will return a string list holding 1 or more links
 Notes:  Here will be the <img ..  > format scanned for:

      Here is some opening text...
        <img src="http://www.geocities.com/kdtop3/OpenVistA.jpg" alt="Image Title 1">
      And here is some more text
        <img src="http://www.geocities.com/kdtop3/OpenVistA_small.jpg" alt="Image Title 2">
      And the saga continues...
        <img src="http://www.geocities.com/kdtop3/pics/Image100.gif" alt="Image Title 3">
         As with html, end-of-lines and white space is not preserved or significant
}

  function GetBetween (var Text : AnsiString; OpenTag,CloseTag : string;
                       KeepTags : Boolean) : string;
  {Purpose: Gets text between Open and Close tags.  Removes any CR's or LF's
   Input: Text - the text to work on.  It IS changed as code is removed
          KeepTags - true if want tag return in result
                     false if tag not in result (still is removed from Text)
   Output: Text is changed.
           Result=the code between the opening and closing tags
   Note: Both OpenTag and CloseTag MUST be present for anything to happen.
  }

    procedure CutInThree(var Text : AnsiString; p1, p2 : Integer; var s1,s2,s3 : AnsiString);
    {Purpose: Cut input string Text into 3 parts, with cut points given by p1 & p2.
              p1 points to first character to be in s2
              p2 points to last character to be in s2        }
    begin
      s1 := ''; s2 := '';  s3 := '';
      if p1 > 1 then s1 := MidStr(Text, 1, p1-1);
      s2 := MidStr(Text, p1, p2-p1+1);
      s3 := MidStr(Text, p2+1, Length(Text)-p2);
    end;

  var
    p1,p2 : integer;
    s1,s2,s3 : AnsiString;

  begin
    Result := ''; //default of no result.

    p1 := Pos(UpperCase(OpenTag), UpperCase(Text));
    if (p1 > 0) then begin
      p2 := Pos(UpperCase(CloseTag),UpperCase(Text)) + Length(CloseTag) -1;
      if ((p2 > 0) and (p2 > p1)) then begin
        CutInThree (Text, p1,p2, s1,Result,s3);
        Text := s1+s3;
        //Now, remove any CR's or LF's
        repeat
          p1 := Pos (Chr(13),Result);
          if p1= 0 then p1 := Pos (Chr(10),Result);
          if (p1 > 0) then begin
            CutInThree (Result, p1,p1, s1,s2,s3);
            Result := s1+s3;
//            Text := MidStr(Text,1,p1-1) + MidStr(Text,p1+1,Length(Text)-p1);
          end;
        until (p1=0);
        //Now cut off boundry tags if requested.
        if not KeepTags then begin
          p1 := Length(OpenTag) + 1;
          p2 := Length (Result) - Length (CloseTag);
          CutInThree (Result, p1,p2, s1,s2,s3);
          Result := s2;
        end;
      end;
    end;
  end;

var
  Text : AnsiString;
  Line : string;

begin
  Result := false;  //set default
  if (ImageList <> nil) then begin
    ImageList.Clear;  //set default
    Text := Lines.Text;  //Get entire note into one long string
    repeat
      Line := GetBetween (Text, '<img', '>', true);
      if Line <> '' then begin
        ImageList.Add(Line);
        Result := true;
      end;
    until Line = '';
    //Note: The following works, but need to replace removed links
    // with "[Title]"   Work on later...
    //memNote.Lines.Text := Text;
  end;
end;



end.