ie의 스크롤 영영까지 포함해서 캡쳐하는 팁!

http://www.delphipages.com/ 에서 봤던 ie의 스크롤 영영까지 포함해서 캡쳐하는 팁이 있더군요..

참고하세요..^^

unit Unit1; 

interface 

uses 
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
   Dialogs, MSHTML, StdCtrls, ExtCtrls, OleCtrls, SHDocVw, gifimage; 

const 
   IID_IHTMLElementRender: TGUID = '{3050F669-98B5-11CF-BB82-00AA00BDCE0B}'; 

type 
   IHTMLElementRender = interface(IUnknown) 
      ['{3050F669-98B5-11CF-BB82-00AA00BDCE0B}'] 
      function DrawToDC 
         (_hDC: HDC 
         ): HResult; stdcall; 
   end; 

   TForm1 = class(TForm) 
      Panel1: TPanel; 
      Panel2: TPanel; 
      sdSaveDialog: TSaveDialog; 
      Panel3: TPanel; 
      ScrollBox1: TScrollBox; 
      Image1: TImage; 
      btnSave: TButton; 
      Panel4: TPanel; 
      wb: TWebBrowser; 
      edtURL: TEdit; 
      btnGet: TButton; 
      procedure btnGetClick(Sender: TObject); 
      procedure wbDocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); 
      procedure FormCreate(Sender: TObject); 
      procedure btnSaveClick(Sender: TObject); 
   private 
      { Private declarations } 
   public 
      { Public declarations } 
   end; 

var 
   Form1: TForm1; 

implementation 

{$R *.dfm} 

procedure color2gray(var image2: TBitmap; image1: TBitmap); 
var 
   grayPal: TMaxLogPalette; 
   i: Integer; 
begin 
   for i := 0 to 255 do 
      with grayPal.palPalEntry[i] do begin 
         peRed := i; 
         peGreen := i; 
         peBlue := i; 
         peFlags := 0; 
      end; 
   grayPal.palVersion := $0300; 
   grayPal.palNumEntries := 256; 

   Image2.PixelFormat := pf8bit; 
   Image2.Palette := CreatePalette(PLogPalette(@grayPal)^); 
   Image2.Width := Image1.Width; 
   Image2.Height := Image1.Height; 

   Image2.Canvas.Draw(0, 0, Image1); 
end; 

procedure bmp2gifsave(bmp: TBitmap; fName: string); 
var 
   i: Integer; 
   gif: TGifimage; 
begin 
   gif := TGifimage.Create; 

   try 
      gif.Assign(bmp); 

      if fileExists(fName) then 
         DeleteFile(fName); 

      gif.SaveToFile(fName); 
   finally 
      gif.Free; 
   end; 

end; 

function CreateWBSnapshot(Browser: TWebBrowser; OutputSize: TPoint): TBitmap; 
var 
   pDoc: IHTMLDocument2; 
   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; 
const 
   OffsetWidth = 170; 
   OffsetHeight = 260; 
begin 

   // Create resulting image 
   result := TBitmap.Create; 

   // Set size 
   result.Width := OutputSize.x - OffsetWidth - 70; 
   result.Height := OutputSize.y - OffsetHeight - 200; 

   // Check browser document 
   if Assigned(Browser.Document) and 
      (Browser.Document.QueryInterface(IHTMLDocument2, pDoc) = S_OK) then begin 
      // Lock update 
      LockWindowUpdate(Browser.Handle); 
      // Resource protection 
      try 
         // Check document body 
         if Assigned(pDoc.Body) and (pDoc.Body.QueryInterface(IHTMLElement2, 
            pElement) = S_OK) then begin 
            // Resource protection 
            try 
               // Get the renderer 
               if (pElement.QueryInterface(IID_IHTMLElementRender, pRender) = 
                  S_OK) 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; 
                     // 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 - OffsetWidth, 0 - OffsetHeight, 
                           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 interface 
                     pRender := nil; 
                  end; 
               end; 
            finally 
               // Release interface 
               pElement := nil; 
            end; 
         end; 
      finally 
         // Unlock update 
         LockWindowUpdate(0); 
         // Release interface 
         pDoc := nil; 
      end; 
   end; 

   color2gray(result, result); 

   bmp2gifsave(result, 'c:\test.gif'); 

end; 

procedure TForm1.btnGetClick(Sender: TObject); 
begin 
   Screen.Cursor := crHourGlass; 
   if Length(Trim(edtURL.Text)) > 0 then begin 
      wb.Navigate(edtURL.Text); 
   end 
   else 
      ShowMessage('URL can not be blank'); 
end; 

procedure TForm1.wbDocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); 
var 
   pDoc: IHTMLDocument2; 
   pElement: IHTMLElement2; 
   x, y: Integer; 
begin 
   if URL <> 'about:blank' then begin 

      pDoc := wb.Document as IHTMLDocument2; 
      pElement := pDoc.body as IHTMLElement2; 

      y := pElement.scrollHeight; 
      x := pElement.scrollWidth; 

      Image1.Picture.Bitmap.Assign(CreateWBSnapshot(wb, Point(x, y))); 
      Screen.Cursor := crDefault; 
   end; 
end; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
   sdSaveDialog.DefaultExt := GraphicExtension(TBitmap); 
   sdSaveDialog.Filter := GraphicFilter(TBitmap); 
   wb.Navigate('about:blank'); 
end; 

procedure TForm1.btnSaveClick(Sender: TObject); 
begin 
   if sdSaveDialog.Execute then begin 
      Image1.Picture.Bitmap.SaveToFile(sdSaveDialog.FileName); 
   end; 
end; 

end.