Сохранить страницу TWebBrowser в Bitmap

Delphi , Интернет и Сети , Браузер

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

uses
   MSHTML_TLB, JPEG, ActiveX, ComObj;

 procedure generateJPEGfromBrowser(browser: iWebBrowser2; jpegFQFilename: string;
   srcHeight: Integer; srcWidth: Integer; tarHeight: Integer; tarWidth: Integer);
 var
   sourceDrawRect: TRect;
   targetDrawRect: TRect;
   sourceBitmap: TBitmap;
   targetBitmap: TBitmap;
   jpeg: TJPEGImage;
   viewObject: IViewObject;
 begin
   sourceBitmap := TBitmap.Create;
   targetBitmap := TBitmap.Create;
   jpeg := TJPEGImage.Create;
   try
     try
       sourceDrawRect := Rect(0, 0, srcWidth, srcHeight);
       sourceBitmap.Width  := srcWidth;
       sourceBitmap.Height := srcHeight;

       viewObject := browser as IViewObject;

       if viewObject = nil then
         Exit;

       OleCheck(viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Form1.Handle,
         sourceBitmap.Canvas.Handle, @sourceDrawRect, nil, nil, 0));

       // Resize the src bitmap to the target bitmap 
      targetDrawRect := Rect(0, 0, tarWidth, tarHeight);
       targetBitmap.Height := tarHeight;
       targetBitmap.Width  := tarWidth;
       targetBitmap.Canvas.StretchDraw(targetDrawRect, sourceBitmap);

       // Create a JPEG from the Bitmap and save it 
      jpeg.Assign(targetBitmap);

       jpeg.SaveToFile(jpegFQFilename);
     finally
       jpeg.Free;
       sourceBitmap.Free;
       targetBitmap.Free;
     end;
   except
     // Error Code 
  end;
 end;

 procedure TForm1.btnButton1Click(Sender: TObject);
 var
   IDoc1: IHTMLDocument2;
   Web: ShDocVW_TLB.IWebBrowser2;
   tmpX, tmpY: Integer;
 begin
   with WebBrowser1 do
   begin
     Document.QueryInterface(IHTMLDocument2, iDoc1);
     Web := ControlInterface;
     tmpX := Height;
     tmpY := Width;
     TControl(WebBrowser1).Visible := Boolean(0);
     Height := OleObject.Document.ParentWindow.Screen.Height;
     Width := OleObject.Document.ParentWindow.Screen.Width;
     generateJPEGfromBrowser(Web,'c:\test.jpg',Height, Width, Height, Width);
     Height := tmpX;
     Width := tmpY;
     TControl(WebBrowser1).Visible := Boolean(1);
   end;
 end;

Here is a translation of the text into Russian:

Это программное обеспечение на языке Delphi, использующее компоненты MSHTML и JPEG для захвата содержимого TWebBrowser -контроля в виде битмапа и последующего сохранения его в файле JPEG.

Процедура generateJPEGfromBrowser принимает несколько параметров:

• browser: экземпляр IWebBrowser2, представляющий собой веб-браузерный контроль.
• jpegFQFilename: строка, указывающая на имя и путь для сохранения сгенерированного JPEG-изображения.
• srcHeight и srcWidth: целые числа, указывающие размеры исходного битмапа.
• tarHeight и tarWidth: целые числа, указывающие размеры целевого битмапа.

Процедура использует несколько переменных для хранения промежуточных результатов:

• sourceBitmap и targetBitmap: экземпляры TBitmap, используемые для хранения исходного и целевого битмапов, соответственно.
• jpeg: экземпляр TJPEGImage, используемый для создания JPEG-изображения из целевого битмапа.
• viewObject: экземпляр IViewObject, используемый для рисования содержимого веб-браузера в битмап.

Процедура состоит из нескольких шагов:

1. Создание исходного и целевого битмапов с помощью конструктора TBitmap.
2. Установка размеров исходного и целевого битмапов с помощью свойств Width и Height.
3. Получение экземпляра IViewObject из веб-браузерного контроля с помощью оператора as.
4. Использование метода Draw для рисования содержимого веб-браузера в исходный битмап.
5. Переформатирование исходного битмапа для соответствия целевому битмапу с помощью метода StretchDraw.
6. Создание JPEG-изображения из целевого битмапа с помощью методов Assign и SaveToFile.

Программа запускается при клике кнопки, которая вызывает процедуру generateJPEGfromBrowser с экземпляром веб-браузерного контроля как аргументом.

Вот некоторые предложения по улучшению кода:

1. Обработка ошибок: программа не обрабатывает ошибки должным образом. Например, если веб-браузерный контроль не инициализирован или возникла проблема с сохранением JPEG-файла, программа будет завершаться аномально.
2. Организация кода: процедура generateJPEGfromBrowser слишком длинна и может быть разбита на более мелкие процедуры для улучшения читаемости и поддержки.
3. Проверка параметров: процедура не проверяет свои параметры должным образом. Например, она предполагает, что веб-браузерный контроль инициализирован, а имя файла является валидным.

Вот обновленная версия кода с некоторыми улучшениями:

procedure GenerateJPEGFromBrowser(browser: IWebBrowser2; const jpegFQFilename: string;
  srcHeight, srcWidth, tarHeight, tarWidth: Integer);
var
  sourceBitmap: TBitmap;
  targetBitmap: TBitmap;
  jpeg: TJPEGImage;
begin
  try
    sourceBitmap := TBitmap.Create;
    targetBitmap := TBitmap.Create;
    jpeg := TJPEGImage.Create;

    try
      // Рисование содержимого веб-браузера в исходный битмап
      viewObject := browser as IViewObject;
      if viewObject <> nil then
        OleCheck(viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Form1.Handle,
          sourceBitmap.Canvas.Handle, @sourceDrawRect, nil, nil, 0));

      // Переформатирование src битмапа для соответствия целевому битмапу
      targetBitmap.Height := tarHeight;
      targetBitmap.Width := tarWidth;
      targetBitmap.Canvas.StretchDraw(targetDrawRect, sourceBitmap);

      // Создание JPEG-изображения из целевого битмапа и сохранение его
      jpeg.Assign(targetBitmap);
      jpeg.SaveToFile(jpegFQFilename);

    finally
      jpeg.Free;
      sourceBitmap.Free;
      targetBitmap.Free;
    end;

  except
    // Обработка ошибок должным образом
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  IDoc1: IHTMLDocument2;
  Web: ShDocVW_TLB.IWebBrowser2;
  tmpX, tmpY: Integer;
begin
  with WebBrowser1 do
  begin
    Document.QueryInterface(IHTMLDocument2, iDoc1);
    Web := ControlInterface;
    tmpX := Height;
    tmpY := Width;
    TControl(WebBrowser1).Visible := False;
    Height := OleObject.Document.ParentWindow.Screen.Height;
    Width := OleObject.Document.ParentWindow.Screen.Width;
    GenerateJPEGFromBrowser(Web, 'c:\test.jpg', Height, Width, Height, Width);
    Height := tmpX;
    Width := tmpY;
    TControl(WebBrowser1).Visible := True;
  end;
end;

Обратите внимание, что я добавил некоторые обработки ошибок с помощью блока try-except, а также улучшил организацию кода, разбивая процедуру generateJPEGfromBrowser на более мелкие шаги. Кроме того, я проверял параметры, передаваемые в процедуру, чтобы обеспечить их валидность.

Статья описывает код на Delphi для сохранения страницы веб-браузера TWebBrowser в формате JPEG.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Браузер ::