Solved

Print a HTML CSS document from TWebbrowser object in DELPHI5

Posted on 2010-11-22
9
1,209 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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 

Author Comment

by:sshirey
Comment Utility
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
Comment Utility

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
Comment Utility
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
Comment Utility
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
Comment Utility
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

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
This video explains how to create simple products associated to Magento configurable product and offers fast way of their generation with Store Manager for Magento tool.
You have products, that come in variants and want to set different prices for them? Watch this micro tutorial that describes how to configure prices for Magento super attributes. Assigning simple products to configurable: We assigned simple products…

772 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

12 Experts available now in Live!

Get 1:1 Help Now