Active Window ScreenShot (with a twist)

{WebUtils unit}
unit WebUtils;
////////////////////////////////////////////////////////////////////////////////
//
//   Unit        :  WebUtils
//   Date        :  10.27.2005 (updated 10.28.2005)
//   Description :  Utility functions based on the TWebBrowser object
//
//
//   function GetDocumentSize(Browser: TWebBrowser): TPoint;
//
//      Returns the document's body size as a TPoint, where X = width and Y = height
//
//   function GetBrowserElement(Browser: TWebBrowser; out Element: IHTMLElement2): HResult;
//
//      Returns the actual element required to perform the rendering to a canvas handle.
//      For most pages, this will be the body element. But for some, eg:
//
//         http://www.experts-exchange.com
//         http://www.msn.com
//
//      the parent element will need to be used. The element to use is based on
//      getting the parent and checking it for a clientwidth/height of zero. If zero,
//      then the body element can be used. If not zero, then the parent must be used.
//
//   function CreateThumbnailImage(Browser: TWebBrowser; OutputSize: TPoint): TBitmap;
//
//      Returns a bitmap object of the document page where the width and height is
//      determined by the point (x = width, y=height) passed in OutputSize.
//
//   function CreateScaledImage(Browser: TWebBrowser; Scale: Double): TBitmap;
//
//      Returns a scaled bitmap object of the document page. A scaling of 1.0 will
//      return the page at its actual size. To return a 1/10 scaled image of the
//      document for example, 0.1 would be passed to Scale.
//
////////////////////////////////////////////////////////////////////////////////
interface 
////////////////////////////////////////////////////////////////////////////////
//   Include units
////////////////////////////////////////////////////////////////////////////////
uses
  Windows, SysUtils, Classes, Graphics, ShdocVW, ActiveX, MSHTML; 
////////////////////////////////////////////////////////////////////////////////
//   Constants
////////////////////////////////////////////////////////////////////////////////
const
  IID_IHTMLElementRender: TGUID =  '{3050F669-98B5-11CF-BB82-00AA00BDCE0B}';
////////////////////////////////////////////////////////////////////////////////
//   Interfaces
////////////////////////////////////////////////////////////////////////////////
type
  IHTMLElementRender   =  interface(IUnknown)
     ['{3050F669-98B5-11CF-BB82-00AA00BDCE0B}']
     function DrawToDC(_hDC: HDC): HResult; stdcall;
     function SetDocumentPrinter(const bstrPrinterName: WideString; _hDC: HDC): HResult; stdcall;
  end; 
////////////////////////////////////////////////////////////////////////////////
//   Utility functions
////////////////////////////////////////////////////////////////////////////////
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; 
end.
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309: