Solved

Print a HTML CSS document from TWebbrowser object in DELPHI5

Posted on 2010-11-22
9
1,226 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 4
9 Comments
 
LVL 32

Assisted Solution

by:Ephraim Wangoya
Ephraim Wangoya 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:Ephraim Wangoya
Ephraim Wangoya 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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 32

Expert Comment

by:Ephraim Wangoya
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
 

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:Ephraim Wangoya
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:Ephraim Wangoya
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

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
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…
Michael from AdRem Software outlines event notifications and Automatic Corrective Actions in network monitoring. Automatic Corrective Actions are scripts, which can automatically run upon discovery of a certain undesirable condition in your network.…
Monitoring a network: how to monitor network services and why? Michael Kulchisky, MCSE, MCSA, MCP, VTSP, VSP, CCSP outlines the philosophy behind service monitoring and why a handshake validation is critical in network monitoring. Software utilized …

724 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