Q&A

  • 스크린을 벗어난 윈도우를 캡쳐하는 방법?
안녕하세요
델파이 초짜인데 고생을 하고 있습니다

현재 만드는 프로그램이 특정 윈도우의 이미지를 캡쳐해서 BMP로 저장하는
프로그램을 만드는중인데요
여기저기 기웃거려본 결과
윈도우 핸들로부터 GetDC함수로 화면의 DC를 구해 bitblt로 Copy하는 방법이 일반적이라
간단하게 구현했는데.. 치명적인 문제가 있더군요

문제는 캡쳐하려는 윈도우가 현재 스크린을 벗어나면
스크린을 벗어난 윈도우 영역은 캡쳐가 안되는 문제가 발생합니다...

그래서 구현방법이 처음부터 아예 잘못된거 같은데요..

이렇게 화면을 벗어난 윈도우의 이미지나 다른 윈도우에 가려서 안보이는
윈도우를 캡쳐하기 위해서는 어떤식으로 구현을 해야 할까요??
1  COMMENTS
  • Profile
    nilriri™ 2007.02.16 21:08
    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.