Ir para conteúdo
Fórum Script Brasil
  • 0

(Resolvido) (Screenshot de parte de um WebBrowser)

paulobergo

Perguntado por paulobergo,

 Share

Pergunta

paulobergo

paulobergo

Postado
Postado (editado)

Olá pessoal...

Para capturar a imagem de um WebBrowser, estou usando o seguinte código:

procedure WebBrowserScreenShot(const wb: TWebBrowser; const fileName: TFileName);
var
  viewObject : IViewObject;
  r : TRect;
  bitmap : TBitmap;
begin
  if wb.Document <> nil then
  begin
    wb.Document.QueryInterface(IViewObject, viewObject);
    if Assigned(viewObject) then
    try
      bitmap := TBitmap.Create;
      try
        r := Rect(0, 0, 351, 287);

        bitmap.Width := 352; // wb.Width;
        bitmap.Height := 288; // wb.Height;

        // * gerando uma imagem jpeg 352x288 pixels.

        viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Application.Handle, bitmap.Canvas.Handle, @r, nil, nil, 0);

        with TJPEGImage.Create do
        try
          Assign(bitmap);
          SaveToFile(fileName);
        finally
          Free;
        end;
      finally
        bitmap.Free;
      end;
    finally
      viewObject._Release;
    end;
  end;
end;

Porém, preciso capturar apenas uma parte da página, a partir das coordenadas 201 x 101, ou seja, a imagem precisa capturar o retangulo do webbrowser 201, 101 a 552 x 388 ...

Alguma dica?

Grato!

Abraços!

Editado por paulobergo
Link para o comentário
Compartilhar em outros sites

10 respostass a esta questão

Posts Recomendados

  • 0
Jhonas

Jhonas

Postado
Postado

Experimente desta maneira:

procedure WebBrowserScreenShot(const wb: TWebBrowser; const fileName: TFileName);
var
  viewObject : IViewObject;
  r : TRect;
  bitmap : TBitmap;
begin
  if wb.Document <> nil then
  begin
    wb.Document.QueryInterface(IViewObject, viewObject);
    if Assigned(viewObject) then
    try
      bitmap := TBitmap.Create;
      try
        r := Rect(201, 101, 552, 388);

        bitmap.Height := Screen.Height;
        bitmap.Width := Screen.Width;

        // * gerando uma imagem jpeg

        viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Application.Handle, bitmap.Canvas.Handle, @r, nil, nil, 0);

        with TJPEGImage.Create do
        try
          Assign(bitmap);
          SaveToFile(fileName);
        finally
          Free;
        end;
      finally
        bitmap.Free;
      end;
    finally
      viewObject._Release;
    end;
  end;
end;

abraço

Link para o comentário
Compartilhar em outros sites
  • 0
paulobergo

paulobergo

Postado
  • Autor
Postado

Olá.

Assim ainda não funcionou... a imagem criada até fica com as dimensões reduzidas - 352x288... porém aparece um barra lateral e outra vertical sem imagem...

Então, a solução foi criar um segundo bitmap - bitmapdestino; assim, a página completa do webbrowser é copiada para o primeiro bitmap; deste, é recortada a parte desejada e copiada no bitmap destino; finalmente, do bitmap destino, a figura é convertida em jpeg e salva...

O código:

var
  viewObject : IViewObject;
  r : TRect;
  bitmapdst, bitmap : TBitmap;
  RectOrigem, RectDestino: TRect;
  BitmapFont, BitmapDest, MyBMPImage: TBitmap;
begin
  if wb.Document <> nil then
  begin
    wb.Document.QueryInterface(IViewObject, viewObject);
    if Assigned(viewObject) then
    try
      bitmap    := TBitmap.Create;
      bitmapdst := TBitmap.Create;
      try

        bitmap.Height := wb.Height; // 288; // 322wb.Height;
        bitmap.Width  := wb.Width; // 322; // wb.Width;

        r  := Rect(0, 0, bitmap.width-1, bitmap.height-1);

        viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Application.Handle, bitmap.Canvas.Handle, @r, nil, nil, 0);

        RectOrigem  := Rect(101, 101, 452, 388);
        RectDestino := Rect(0, 0, 351, 287);

        Bitmapdst.Width  := 352;
        Bitmapdst.Height := 288;
        Bitmapdst.Canvas.CopyRect(RectDestino, Bitmap.Canvas, RectOrigem);

        with TJPEGImage.Create do
        try
          Assign(bitmapdst);
          SaveToFile(fileName);
        finally
          Free;
        end;
      finally
        bitmapdst.Free;
        bitmap.Free;
      end;
    finally
      viewObject._Release;
    end;
  end;
end;

Ok? espero que seja útil para outros...

Grato! Abraços!

Link para o comentário
Compartilhar em outros sites
  • 0
Rodrigo Bizz

Rodrigo Bizz

Postado
Postado
Olá.

Assim ainda não funcionou... a imagem criada até fica com as dimensões reduzidas - 352x288... porém aparece um barra lateral e outra vertical sem imagem...

Então, a solução foi criar um segundo bitmap - bitmapdestino; assim, a página completa do webbrowser é copiada para o primeiro bitmap; deste, é recortada a parte desejada e copiada no bitmap destino; finalmente, do bitmap destino, a figura é convertida em jpeg e salva...

O código:

var
  viewObject : IViewObject;
  r : TRect;
  bitmapdst, bitmap : TBitmap;
  RectOrigem, RectDestino: TRect;
  BitmapFont, BitmapDest, MyBMPImage: TBitmap;
begin
  if wb.Document <> nil then
  begin
    wb.Document.QueryInterface(IViewObject, viewObject);
    if Assigned(viewObject) then
    try
      bitmap    := TBitmap.Create;
      bitmapdst := TBitmap.Create;
      try

        bitmap.Height := wb.Height; // 288; // 322wb.Height;
        bitmap.Width  := wb.Width; // 322; // wb.Width;

        r  := Rect(0, 0, bitmap.width-1, bitmap.height-1);

        viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Application.Handle, bitmap.Canvas.Handle, @r, nil, nil, 0);

        RectOrigem  := Rect(101, 101, 452, 388);
        RectDestino := Rect(0, 0, 351, 287);

        Bitmapdst.Width  := 352;
        Bitmapdst.Height := 288;
        Bitmapdst.Canvas.CopyRect(RectDestino, Bitmap.Canvas, RectOrigem);

        with TJPEGImage.Create do
        try
          Assign(bitmapdst);
          SaveToFile(fileName);
        finally
          Free;
        end;
      finally
        bitmapdst.Free;
        bitmap.Free;
      end;
    finally
      viewObject._Release;
    end;
  end;
end;

Ok? espero que seja útil para outros...

Grato! Abraços!

Ola Paulo,

Eu consegui rolar aqui, porém, a imagem perde muita qualidade, parece ate que foi dado um zoom nela.

Estou mandando salvar como .bmp

É assim mesmo?? Tem como melhorar a qualidade??

Fico no aguardo.

Link para o comentário
Compartilhar em outros sites
  • 0
paulobergo

paulobergo

Postado
  • Autor
Postado

Olá.

Tem como melhorar ou piorar a qualidade sim.

Para isso, o melhor a fazer é observar o próprio exemplo que acompanha o Delphi.

Abra o projeto jpegproj.

Ele fica em: c:\arquivos de programas\borland\delphi6\help\examples\jpeg

Verá no código que não é complicado melhorar ou reduzir a qualidade da imagem.

Veja, por exemplo, como definir várias opções com relação à imagem:

.

.

.

procedure TForm1.SetJPEGOptions(Sender: TObject);
var
  Temp: Boolean;
begin
  Temp := Image1.Picture.Graphic is TJPEGImage;
  if Temp then
    with TJPEGImage(Image1.Picture.Graphic) do
    begin
      PixelFormat := TJPEGPixelFormat(Self.PixelFormat.ItemIndex);
      Scale := TJPEGScale(Self.Scale.ItemIndex);
      Grayscale := Boolean(Colorspace.ItemIndex);
      Performance := TJPEGPerformance(Self.Performance.ItemIndex);
      ProgressiveDisplay := Self.ProgressiveDisplay.Checked;
    end;
  Scale.Enabled := Temp;
  PixelFormat.Enabled := Temp;
  Colorspace.Enabled := Temp;
  Performance.Enabled := Temp;
  ProgressiveDisplay.Enabled := Temp
    and TJPEGImage(Image1.Picture.Graphic).ProgressiveEncoding;
  Image1.IncrementalDisplay := IncrementalDisplay.Checked;
end;

.

.

.

Ok?

Abraços!

Link para o comentário
Compartilhar em outros sites
  • 0
Micheus

Micheus

Postado
Postado
Tem como melhorar ou piorar a qualidade sim.
paulobergo, sobre esta questão, vou acrescentar ao seu exemplo a propriedade CompressionQuality que corresponde a um valor percentual (valores de 0..100). Quanto menor este número, pior e o tamanho do arquivo cresce proporcionalmente a este valor.

Abraços

Link para o comentário
Compartilhar em outros sites
  • 0
Rodrigo Bizz

Rodrigo Bizz

Postado
Postado (editado)
Olá.

Tem como melhorar ou piorar a qualidade sim.

Para isso, o melhor a fazer é observar o próprio exemplo que acompanha o Delphi.

Abra o projeto jpegproj.

Ele fica em: c:\arquivos de programas\borland\delphi6\help\examples\jpeg

Verá no código que não é complicado melhorar ou reduzir a qualidade da imagem.

Veja, por exemplo, como definir várias opções com relação à imagem:

.

Ok?

Abraços!

Paulo.. o exemplo não me ajudo, nem com a dica do Micheus. Acho meio complicado esse negocio de manipulacao de imagem ai. Seguinte..

Com o codigo abaixo a imagem fica com a qualidade que eu quero(qualidade de .bmp). Porem desse modo ele tira um screenshot do webBrowser todo. A ideia do codigo que esta comentado é pegar esse screenshot inicial e fazer uma nova imagem iniciando e terminando em tal posicao. Porem nessa hora a imagem perde qualidade, parece que foi dado um zoom na imagem. To perdido... Help-me.

procedure TForm1.Button3Click(Sender: TObject);
begin
  imgSalvaImagem('C:\Users\Pc\Desktop\imagem.bmp'); 
end;


procedure TForm1.imgSalvaImagem(sArq: String);
  var
                viewObject : IViewObject;
                         r : TRect;
         bitmapdst, bitmap : TImage;
    RectOrigem, RectDestino: TRect;
  begin
  if webBrowser1.Document <> nil then
    begin
      webBrowser1.Document.QueryInterface(IViewObject, viewObject);
      if Assigned(viewObject) then
      try
        bitmap    :=  TImage.Create(Self);
        bitmapdst := TImage.Create(Self);

        bitmap.Height := webBrowser1.Height;
        bitmap.Width  := webBrowser1.Width;

        r  := Rect(0, 0, bitmap.width, bitmap.height);

        viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Application.Handle, bitmap.Canvas.Handle, @r, nil, nil, 0);

     //   RectOrigem  := Rect(243, 182, 452, 388);
     //   RectDestino := Rect(0, 0, 351, 287);

      //  Bitmapdst.Width  := 144;
     //   Bitmapdst.Height := 13;
      //  Bitmapdst.Canvas.CopyRect(RectDestino, bitmap.Canvas, RectOrigem);
      finally
        viewObject._Release;
      end;
      //Bitmapdst.Picture.Bitmap.SaveToFile(sArq); //imagem recortada
        bitmap.Picture.Bitmap.SaveToFile(sArq);  //print original
    end;
  end;

Editado por Rodrigo Bizz
Link para o comentário
Compartilhar em outros sites
  • 0
Jhonas

Jhonas

Postado
Postado
Com o codigo abaixo a imagem fica com a qualidade que eu quero(qualidade de .bmp). Porem desse modo ele tira um screenshot do webBrowser todo. A ideia do codigo que esta comentado é pegar esse screenshot inicial e fazer uma nova imagem iniciando e terminando em tal posicao. Porem nessa hora a imagem perde qualidade, parece que foi dado um zoom na imagem. To perdido... Help-me.

Este código recorta a imagem iniciando e terminando em tal posicao da figura, sem peder a qualidade de imagem.

Voce deve adaptar este código ao seu anterior ( Veja se consegue )

unit UNovo;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;

    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
    Retangulo : TRect;
  end;

var
  Form1: TForm1;
  old, new : TPoint;
  Press:boolean;
implementation

{$R *.DFM}

procedure Desenhar;
begin
  Form1.Image1.Canvas.moveto(new.x, new.y);
  Form1.Image1.Canvas.lineto(new.x, old.y);
  Form1.Image1.Canvas.lineto(old.x, old.y);
  Form1.Image1.Canvas.lineto(old.x, new.y);
  Form1.Image1.Canvas.lineto(new.x, new.y);
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   if not press then
      begin
        old.X := X;
        old.Y := Y;
      end;

    Retangulo.Left:=old.x;
    Retangulo.Top:=old.Y;
    Retangulo.Right:=x;
    Retangulo.Bottom:=y;

    form1.Canvas.CopyRect(Retangulo, form1.Image1.Canvas, Retangulo);
    form1.Image1.Canvas.Pen.Style := psDash;

end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin

   if not press then
      press:=true;

   old.x:= x;
   old.y:= y;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   press:= false; 
   //form1.Canvas.CopyRect(Retangulo, form1.Image1.Canvas, Retangulo);
   new.x:= x;
   new.y:= y;

   desenhar;
end;

end.

OBS: A imagem principal estará em um TImage onde voce usará o mouse para recortar o pedaço dela e a imagem recortada estara no Canvas do Form... a partir dai voce pode salvar a imagem do canvas como jpeg sem perder a qualidade

abraço

Link para o comentário
Compartilhar em outros sites
  • 0
Rodrigo Bizz

Rodrigo Bizz

Postado
Postado

Galera, depois de ficar o dia inteiro tentando todas as dicas de voces ... voltei ao inicio e descobri porque estava perdendo a qualidade(ficava deformada, parecia um zoom na imagem).

O problema era nessa parte:

RectOrigem := Rect(248, 183, 498, 199);

RectDestino := Rect(0, 0, 250, 16);

não sei explicar muito bem... mais fiz o seguinte... Como coloquei "0,0" na primeira parte ali do RectDestino as outras duas coordenadas seguintes eu diminu em relacao ao RectOrigem.. 498-248=250 e 199-183=16

Dessa forma não deformou nada.

Pra mim ficou do jeito que precisava assim.

Valeu.

Link para o comentário
Compartilhar em outros sites
  • 0
Micheus

Micheus

Postado
Postado
... voltei ao inicio e descobri porque estava perdendo a qualidade(ficava deformada, parecia um zoom na imagem).

O problema era nessa parte:

RectOrigem := Rect(248, 183, 498, 199);

RectDestino := Rect(0, 0, 250, 16);

não sei explicar muito bem... mais fiz o seguinte... Como coloquei "0,0" na primeira parte ali do RectDestino as outras duas coordenadas seguintes eu diminu em relacao ao RectOrigem.. 498-248=250 e 199-183=16

Rodrigo Bizz, faz todo o sentido que isto funcione.

Observe que o destino tem apenas o tamanho da área que você selecionou (largura e altura) - o que é correto.

Realmente passou-nos batido no seu - post#7 o fato de você não ter usado a proporção que o colega paulobergo havia mantido no seu exemplo:

...
     //   RectOrigem  := Rect(243, 182, 452, 388);
     //   RectDestino := Rect(0, 0, 351, 287);
onde RectDestino deveria ser Rect(0, 0, 209, 206) Use deste modo que não terá mais problemas: 
...
    RectOrigem  := Rect(243, 182, 452, 388);
    RectDestino := Rect(0, 0, RectOrigem.Right -RectOrigem.Left, RectOrigem.Boittom -RectOrigem.Top);
    Bitmapdst.Width  := RectDestino.Right +1;
    Bitmapdst.Height := RectDestino.Bottom +1;

Abraços

Link para o comentário
Compartilhar em outros sites
  • 0
FernandoAO

FernandoAO

Postado
Postado

Olá. Desculpe desenterrar o assunto, mas é porque uso a mesma função ou procedure pra capturar imagens de um Twebbrowser. O problema é que preciso capturar constantemente e após a decima quarta captura, o programa dá um erro e algumas vezes o erro esteve relacionado a mshtml.dll. Alguém poderia ajudar?

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,1k
    • Posts
      651,8k
×
×
  • Criar Novo...