Solved

Print a HTML CSS document from TWebbrowser object in DELPHI5

Posted on 2010-11-22
9
1,213 Views
Last Modified: 2013-11-23
I am displaying a HTML CSS document in a TWebBrowser window.  I need to print the document
to the printer with "backgrounds" and "colors" addressed by "urls" in the HTML document.

I've tried various solutions from other users and find -
1)  Using the OLECMDID_PRINT, I lose the background and colors in the document that are pulled by
using an "url" address [same as if printed directly from Internet Explorer]
2)  If a take an image snapshot - I get the blank area around the document along with the scrollbars displayed
in my image.  Also, trying to print this image does not not display as a full page size.

So - I need to be able to print a document displayed within the TWebBrower window and have the page
look exactly as the screen looks in Delph5.  Any ideas?
0
Comment
Question by:sshirey
  • 5
  • 4
9 Comments
 
LVL 32

Assisted Solution

by:ewangoya
ewangoya earned 500 total points
ID: 34193846
You can first render the page as a bitmap. This ensures you have all the images, backgrounds ..

Then send the Bitmap to the printer

Below is code to get the render the page as a bitmap

To use it

procedure TForm3.btnPrintClick(Sender: TObject);
var
  pDoc: IHTMLDocument2;
  pElement: IHTMLElement2;
  x, y: Integer;
  Bitmap: TBitmap;
begin
  pDoc := WebBrowser1.Document as IHTMLDocument2;
  pElement := pDoc.body as IHTMLElement2;
  y := pElement.scrollHeight;
  x := pElement.scrollWidth;
  Bitmap := CreateThumbnailImage(WebBrowser1, Point(x, y));
  try
   //here I'm just saving it to file, You can send it to the printer
    Bitmap.SaveToFile(IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + 'test1.bmp');
  finally
    FreeAndNil(Bitmap);
  end;
end;
 
uses

  OleCtrls, SHDocVw, MSHTML_TLB {MSHTML};



  //this declaration may be wrong in MSHTML_TLB

  {

  IHTMLElementRender = interface(IUnknown)

    ['{3050F669-98B5-11CF-BB82-00AA00BDCE0B}']

    function DrawToDC(_hDC: HDC): HResult; stdcall;

     function SetDocumentPrinter(const bstrPrinterName: WideString; _hDC: HDC): HResult; stdcall;

  end;

  }



function   GetDocumentSize(Browser: TWebBrowser): TPoint;

function   GetBrowserElement(Browser: TWebBrowser; out Element: IHTMLElement2): HResult;

function   CreateThumbnailImage(Browser: TWebBrowser; OutputSize: TPoint): TBitmap;

function   CreateScaledImage(Browser: TWebBrowser; Scale: Double): TBitmap;



implementation



function GetBrowserElement(Browser: TWebBrowser; out Element: IHTMLElement2): HResult;

var  pDoc:          IHTMLDocument2;

     pElemParent:   IHTMLElement;

     pElement:      IHTMLElement;

     pElement2:     IHTMLElement2;

begin



  // Check browser document

  if Assigned(Browser.Document) then

  begin

     // QI for document 2 interface

     result:=Browser.Document.QueryInterface(IHTMLDocument2, pDoc);

     // Check result

     if Succeeded(result) then

     begin

        // Resource protection

        try

           // Check document body

           if Assigned(pDoc.Body) then

           begin

              // QI for body element

              result:=pDoc.Body.QueryInterface(IHTMLElement, pElement);

              // Check result

              if Succeeded(result) then

              begin

                 // Resource protection

                 try

                    // Get parent element

                    pElemParent:=pElement.parentElement;

                    // Check parent

                    if Assigned(pElemParent) then

                    begin

                       // Resource protection

                       try

                          // Get the element 2 interface

                          if Succeeded(pElemParent.QueryInterface(IHTMLElement2, pElement2)) then

                          begin

                             // Check parent interface for zero client width or height

                             if (pElement2.clientWidth = 0) or (pElement2.clientHeight = 0) then

                                // QI for element 2 interface

                                result:=pElement.QueryInterface(IHTMLElement2, Element)

                             else

                                // We have the element we are after

                                Element:=pElement2;

                          end

                          else

                             // QI for element 2 interface

                             result:=pElement.QueryInterface(IHTMLElement2, Element);

                       finally

                          // Release the interface

                          pElemParent:=nil;

                       end;

                    end

                    else

                       // Return nearest COM error

                       result:=E_NOINTERFACE;

                 finally

                    // Release the interface

                    pElement:=nil;

                 end;

              end;

           end

           else

              // Return nearest COM error

              result:=E_NOINTERFACE;

        finally

           // Release the interface

           pDoc:=nil;

        end;

     end;

  end

  else

     // Return nearest COM error

     result:=E_NOINTERFACE;



end;



function GetDocumentSize(Browser: TWebBrowser): TPoint;

var  pElement:      IHTMLElement2;

begin



  // Get the browser body element interface

  if Succeeded(GetBrowserElement(Browser, pElement)) then

  begin

     // Resource protection

     try

        // Set result size

        result:=Point(pElement.ScrollWidth, pElement.ScrollHeight);

     finally

        // Release the interface

        pElement:=nil;

     end;

  end



end;



function CreateScaledImage(Browser: TWebBrowser; Scale: Double): TBitmap;

var  ptActual:      TPoint;

     ptScale:       TPoint;

begin



  // Get actual size

  ptActual:=GetDocumentSize(Browser);



  // Apply the scaling to it

  ptScale.x:=Round(ptActual.x * Scale);

  ptScale.y:=Round(ptActual.y * Scale);



  // Get the image

  result:=CreateThumbnailImage(Browser, ptScale);



end;



function CreateThumbnailImage(Browser: TWebBrowser; OutputSize: TPoint): TBitmap;

var  pElement:      IHTMLElement2;

     pRender:       IHTMLElementRender;

     bmpRender:     Array [0..1] of TBitmap;

     dwClientWidth: Integer;

     dwClientHeight:Integer;

     dwIndex:       Integer;

     dwX:           Integer;

     dwLastX:       Integer;

     bDoneX:        Boolean;

     dwY:           Integer;

     dwLastY:       Integer;

     bDoneY:        Boolean;

begin



  // Create resulting image

  result:=TBitmap.Create;



  // Set size

  result.Width:=OutputSize.x;

  result.Height:=OutputSize.y;



  // Lock update

  LockWindowUpdate(Browser.Handle);



  // Resource protection

  try

     // Get the browser body element interface

     if Succeeded(GetBrowserElement(Browser, pElement)) then

     begin

        // Resource protection

        try

           // Get the renderer

           if Succeeded(pElement.QueryInterface(IID_IHTMLElementRender, pRender)) then

           begin

              // Resource protection

              try

                 // Create images to blit the parts to

                 for dwIndex:=0 to 1 do

                 begin

                    bmpRender[dwIndex]:=TBitmap.Create;

                    bmpRender[dwIndex].Width:=pElement.scrollWidth;

                    bmpRender[dwIndex].Height:=pElement.scrollHeight;

                 end;

                 // Set render "printer"

                 pRender.SetDocumentPrinter('Bitmap', bmpRender[0].Canvas.Handle);

                 // Get client width and height

                 dwClientWidth:=pElement.clientWidth;

                 dwClientHeight:=pElement.clientHeight;

                 // Resource protection

                 try

                    // Set starting X variables

                    dwX:=pElement.scrollWidth;

                    dwLastX:=(-1);

                    bDoneX:=False;

                    // Loop while X not done

                    while not(bDoneX) do

                    begin

                       // Scroll

                       pElement.scrollLeft:=dwX;

                       // Get scroll

                       dwX:=pElement.scrollLeft;

                       // Check for (-1)

                       if (dwLastX = (-1)) then dwLastX:=dwX + dwClientWidth;

                       // Set starting Y variables

                       dwY:=pElement.scrollHeight;

                       dwLastY:=(-1);

                       bDoneY:=False;

                       // Loop while Y not done

                       while not(bDoneY) do

                       begin

                          // Scroll

                          pElement.scrollTop:=dwY;

                          // Get scroll

                          dwY:=pElement.scrollTop;

                          // Check for (-1)

                          if (dwLastY = (-1)) then dwLastY:=dwY + dwClientHeight;

                          // Draw to bitmap handle

                          if (pRender.DrawToDC(bmpRender[0].Canvas.Handle) = S_OK) then

                          begin

                             // Blit the image

                             BitBlt(bmpRender[1].Canvas.Handle, dwX, dwY, dwLastX-dwX, dwLastY-dwY, bmpRender[0].Canvas.Handle, 2, 2,SRCCOPY);

                          end;

                          // Update the Y variables

                          bDoneY:=(dwY = 0);

                          dwLastY:=dwY;

                          Dec(dwY, (dwClientHeight-4));

                       end;

                       // Update the X variables

                       bDoneX:=(dwX = 0);

                       dwLastX:=dwX;

                       Dec(dwX, (dwClientWidth-4));

                    end;

                    // Stretch draw the image to the resulting bitmap

                    StretchBlt(result.Canvas.Handle, 0, 0, OutputSize.x, OutputSize.y, bmpRender[1].Canvas.Handle, 0, 0, bmpRender[1].Width, bmpRender[1].Height, SRCCOPY);

                 finally

                    // Free the bitmap

                    for dwIndex:=0 to 1 do FreeAndNil(bmpRender[dwIndex]);

                 end;

              finally

                 // Release the interface

                 pRender:=nil;

              end;

           end;

        finally

           // Release the interfaces

           pElement:=nil;

        end;

     end;

  finally

     // Unlock update

     LockWindowUpdate(0);

  end;



end;

Open in new window

0
 
LVL 32

Assisted Solution

by:ewangoya
ewangoya earned 500 total points
ID: 34193974
Here's basic code to print a bitmap

uses
  Printers;

procedure PrintBitmap(ABitMap: TBitmap);
var
  ScaleX, ScaleY: Integer;
  RR: TRect;
begin
  with Printer do
  begin
    BeginDoc;
    try
      ScaleX := GetDeviceCaps(Handle, logPixelsX) div PixelsPerInch;
      ScaleY := GetDeviceCaps(Handle, logPixelsY) div PixelsPerInch;
      RR := Rect(0, 0, ABitmap.Width * scaleX, ABitmap.Height * ScaleY);
      Canvas.StretchDraw(RR, ABitmap);
    finally
      EndDoc;   //Methode EndDoc beendet den aktuellen Druckauftrag und schließt die
    end;
  end;
end;

Your print procedure then becomes

procedure TForm3.btnPrintClick(Sender: TObject);
var
  pDoc: IHTMLDocument2;
  pElement: IHTMLElement2;
  x, y: Integer;
  Bitmap: TBitmap;
begin
  pDoc := WebBrowser1.Document as IHTMLDocument2;
  pElement := pDoc.body as IHTMLElement2;
  y := pElement.scrollHeight;
  x := pElement.scrollWidth;
  Bitmap := CreateThumbnailImage(WebBrowser1, Point(x, y));
  try
    PrintBitmap(Bitmap);
  finally
    FreeAndNil(Bitmap);
  end;
end;
 
you can find more bitmap print procedures at
http://www.swissdelphicenter.ch/torry/showcode.php?id=744 
0
 

Author Comment

by:sshirey
ID: 34198234
I tried the code above - but the bitmap being created still has the additional space surrounding the document as part of the image.  My workscreen is 24" so I have alot of blank side space since the document is centered on the screen.  Does it make a difference to the routines above that I am loading the HTML document as  IPersistStreamInit.

Also - when using the printbitmap routine, I'm just getting a blank page printed.  I was receiving an error of PixelsPerInch not being defined - so I used 96 which is what most images are stored at.  I even changed it to not scale the bitmap and get a blank page printed??.

0
 
LVL 32

Expert Comment

by:ewangoya
ID: 34198265
PixelsPerInch is property of form
 
you can change the procedure to be a private form method

procedure TForm1.PrintBitmap(ABitMap: TBitmap);
var
  ScaleX, ScaleY: Integer;
  RR: TRect;
begin
  with Printer do
  begin
    BeginDoc;
    try
      ScaleX := GetDeviceCaps(Handle, logPixelsX) div PixelsPerInch;
      ScaleY := GetDeviceCaps(Handle, logPixelsY) div PixelsPerInch;
      RR := Rect(0, 0, ABitmap.Width * scaleX, ABitmap.Height * ScaleY);
      Canvas.StretchDraw(RR, ABitmap);
    finally
      EndDoc;   //Methode EndDoc beendet den aktuellen Druckauftrag und schließt die
    end;
  end;
end;
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

Author Comment

by:sshirey
ID: 34199876
Unfortunately - I am using a TFrame for display and do not have a PixelsPerInch Property.

Also - is there any way of removing the excess space around the document when creating the bitmap.  Do not need the extra blank space when trying to print.
Thanks
0
 
LVL 32

Expert Comment

by:ewangoya
ID: 34202054

I tested this and did not get any extra spaces. I'll take a look at the PrintBitmap procedure again.
for PixelsPerInch
If you are not using forms, use Screen.PixelsPerInch
....
ScaleX := GetDeviceCaps(Handle, logPixelsX) div Scree.PixelsPerInch
....
0
 
LVL 32

Expert Comment

by:ewangoya
ID: 34202447
I have attached routines to crop the bitmap from
http://delphi-snippets.blogspot.com/2005/08/automatic-cropping-of-bitmap_18.html

In the button print click do

procedure TForm3.btnPrintClick(Sender: TObject);
var
  pDoc: IHTMLDocument2;
  pElement: IHTMLElement2;
  x, y: Integer;
  Bitmap: TBitmap;
  Color: TColor;
begin
  pDoc := WebBrowser1.Document as IHTMLDocument2;
  pElement := pDoc.body as IHTMLElement2;
  y := pElement.scrollHeight;
  x := pElement.scrollWidth;

  Bitmap := CreateThumbnailImage(WebBrowser1, Point(x, y));
  try
    //remove back color
    Color := Bitmap.Canvas.Pixels[Bitmap.Width, Bitmap.Height];
    AutoCropBitmap(Bitmap, 0, Color);
    Color := Bitmap.Canvas.Pixels[0, 0];
    AutoCropBitmap(Bitmap, 0, Color);
 
    //This wont have a gray background anymore
    Bitmap.SaveToFile(IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + 'test1.bmp');
  finally
    FreeAndNil(Bitmap);
  end;
end;
unit unBitmapCropping;



interface



uses

  Windows, Graphics, Dialogs, SysUtils, Math, Classes;



const

  PixelCountMax = 32768;



type

  pRGBArray = ^TRGBArray;

  TRGBArray = array[0..PixelCountMax-1] of TRGBTriple;



procedure AutoCropBitmap(InputBitmap, OutputBitmap: TBitmap; iBleeding : Integer); overload;

procedure AutoCropBitmap(InputBitmap, OutputBitmap: TBitmap; iBleeding : Integer; BackColor: TColor); overload;

procedure AutoCropBitmap(BitMapToCrop: TBitmap; iBleeding : Integer); overload;

procedure AutoCropBitmap(BitMapToCrop: TBitmap; iBleeding : Integer; BackColor: TColor); overload;

procedure AutoCropBmp(const sFileName : String; iBleeding : Integer); overload;

procedure AutoCropBmp(const sFileName : String; iBleeding : Integer; BackColor: TColor); overload;



implementation



procedure AutoCropBitmap(BitMapToCrop: TBitmap; iBleeding : Integer);

var

  bmpTmp : TBitmap;

begin

  bmpTmp := TBitmap.Create;

  try

    AutoCropBitmap(BitMapToCrop,bmpTmp,iBleeding);

    BitMapToCrop.Assign(bmpTmp);

  finally

    bmpTmp.Free;

  end;

end;



procedure AutoCropBitmap(BitMapToCrop: TBitmap; iBleeding : Integer; BackColor: TColor);

var

  bmpTmp : TBitmap;

begin

  bmpTmp := TBitmap.Create;

  try

    AutoCropBitmap(BitMapToCrop,bmpTmp,iBleeding, BackColor);

    BitMapToCrop.Assign(bmpTmp);

  finally

    bmpTmp.Free;

  end;

end;



procedure AutoCropBitmap(InputBitmap, OutputBitmap: TBitmap; iBleeding : Integer);

begin

  AutoCropBitmap(InputBitmap,OutputBitmap, iBleeding, InputBitmap.Canvas.Pixels[0,0]);

end;



procedure AutoCropBitmap(InputBitmap, OutputBitmap: TBitmap; iBleeding : Integer; BackColor: TColor);

var

  Row: pRGBArray;

  MyTop, MyBottom, MyLeft, i, j, MyRight: Integer;

begin

  MyTop := InputBitmap.Height;

  MyLeft := InputBitmap.Width;

  MyBottom := 0;

  MyRight := 0;

  InputBitmap.PixelFormat := pf24bit;

  OutputBitmap.PixelFormat := pf24Bit;

  { Find Top }

  for j := 0 to InputBitmap.Height-1 do

  begin

    if j > MyTop then

      Break;

    Row := pRGBArray(InputBitmap.Scanline[j]);

    for i:= InputBitmap.Width - 1 downto 0 do

      if ((Row[i].rgbtRed   <> GetRvalue(BackColor)) or (Row[i].rgbtGreen <> GetGvalue(BackColor)) or (Row[i].rgbtBlue  <> GetBvalue(BackColor))) then

      begin

        MyTop := j;

        Break;

      end;

  end;

  if MyTop = InputBitmap.Height then{ Empty Bitmap }

    MyTop := 0;

  { Find Bottom }

  for j := InputBitmap.Height-1 Downto MyTop do

  begin

    if (j + 1) < MyBottom then

      Break;



    Row := pRGBArray(InputBitmap.Scanline[j]);

    for i:= InputBitmap.Width - 1 downto 0  do

      if ((Row[i].rgbtRed   <> GetRvalue(BackColor)) or (Row[i].rgbtGreen <> GetGvalue(BackColor)) or (Row[i].rgbtBlue  <> GetBvalue(BackColor))) then

      begin

        MyBottom := j+1;

        Break;

      end;

  end;

  { Find Left }

  for j := MyTop to MyBottom-1 do

  begin

    Row := pRGBArray(InputBitmap.Scanline[j]);

    for i:= 0 to MyLeft-1 do

      if ((Row[i].rgbtRed <> GetRvalue(BackColor)) or (Row[i].rgbtGreen <> GetGvalue(BackColor)) or(Row[i].rgbtBlue  <> GetBvalue(BackColor))) then

      begin

        MyLeft := i;

        Break;

      end;

  end;

  if MyLeft = InputBitmap.Width then   { Empty Bitmap }

    MyLeft := 0;     { Find Right }



  for j := MyTop to MyBottom -1 do

  begin

    Row := pRGBArray(InputBitmap.Scanline[j]);

    for i:= InputBitmap.Width-1 downto MyRight do

      if ((Row[i].rgbtRed <> GetRvalue(BackColor)) or (Row[i].rgbtGreen <> GetGvalue(BackColor)) or (Row[i].rgbtBlue  <> GetBvalue(BackColor))) then

      begin

        MyRight := i+1;

        Break;

      end;

  end;



  if (MyRight = 0) or (MyBottom = 0) then   { Empty Bitmap }

    iBleeding := 0;



  OutputBitmap.Width  := MyRight - MyLeft + (iBleeding * 2);

  OutputBitmap.Height := MyBottom - MyTop + (iBleeding * 2);

  OutputBitmap.Canvas.Brush.Color := BackColor;

  OutputBitmap.Canvas.FillRect(Rect(0,0,OutputBitmap.Width,OutputBitmap.Height));

  BitBlt(OutputBitmap.canvas.Handle, -MyLeft + iBleeding, -MyTop + iBleeding,MyLeft + MyRight,MyTop + MyBottom, InputBitmap.Canvas.Handle, 0, 0, SRCCOPY);

end;



procedure AutoCropBmp(const sFileName : String; iBleeding : Integer);

var

  InputBitmap, OutputBitmap : TBitmap;

begin

  if not FileExists(sFileName) then

    raise Exception.Create('File doesn''s exists.');

  InputBitmap   := TBitmap.Create;

  OutputBitmap  := TBitmap.Create;

  try

    InputBitmap.LoadFromFile(sFileName);

    OutputBitmap.PixelFormat := InputBitmap.PixelFormat;

    AutoCropBitmap(InputBitmap, OutputBitmap,iBleeding);

    OutputBitmap.SaveToFile(sFileName);

  finally

    OutputBitmap.Free;

    InputBitmap.Free;

  end;

end;



procedure AutoCropBmp(const sFileName : String; iBleeding : Integer; BackColor: TColor);

var

  InputBitmap, OutputBitmap : TBitmap;

begin

  if not FileExists(sFileName) then

    raise Exception.Create('File doesn''s exists.');



  InputBitmap   := TBitmap.Create;

  OutputBitmap  := TBitmap.Create;

  try

    InputBitmap.LoadFromFile(sFileName);

    OutputBitmap.PixelFormat := InputBitmap.PixelFormat;

    AutoCropBitmap(InputBitmap, OutputBitmap,iBleeding, BackColor);

    OutputBitmap.SaveToFile(sFileName);

  finally

    OutputBitmap.Free;

    InputBitmap.Free;

  end;

end;



end.

Open in new window

0
 

Accepted Solution

by:
sshirey earned 0 total points
ID: 34208465
Cropping logic didn't seem to work for my case.  I'm still wondering if it is because I navigate to "about:blank" and then load in my html as a IPersistStreamInit.

So - I changed the html to force alignment on the left side of the web browser and set my bit map generated width to 768.  This allowed for printing just the page with not background.  Your logic to pick up the "entire document wtihout scroll batrs" and creatingthe bitmap helped alot in getting this far.

I am accepting your solution and closing this case.

Thanks alot for all your guidance and help on this problem.

 
0
 

Author Closing Comment

by:sshirey
ID: 34228767
Part of my problem I think is the HTML document I'm working with and how I am loading it into the TWebBrowser.  
Some items suggested didn't work for me - but probably would for other HTML documents and users.

I could not of gotten as far on my project as where I stand today without ewangoya's assistance.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
delphi exception 7 61
Working with hours 3 45
LAN or WAN ? 11 81
how to send memory stream from ics Client To ics server ? 11 79
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.
This is a video describing the growing solar energy use in Utah. This is a topic that greatly interests me and so I decided to produce a video about it.

943 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now