?
Solved

Print a HTML CSS document from TWebbrowser object in DELPHI5

Posted on 2010-11-22
9
Medium Priority
?
1,231 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 2000 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 2000 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
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
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

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

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

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
This tutorial will teach you the special effect of super speed similar to the fictional character Wally West aka "The Flash" After Shake : http://www.videocopilot.net/presets/after_shake/ All lightning effects with instructions : http://www.mediaf…
In this video you will find out how to export Office 365 mailboxes using the built in eDiscovery tool. Bear in mind that although this method might be useful in some cases, using PST files as Office 365 backup is troublesome in a long run (more on t…
Suggested Courses

771 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