Carregar html com imagem no WPTools

01/04/2016

0

Como carregar html com imagem no WPTools, de forma a que a imagem fique visível?
Estou usando a versão 6 do wptools (com delphi 7) e nela quando um html é carregado pro editor a imagem fica apenas com um quadradinho branco (se for base64 ou uma caixa com X vermelho se for link)

Obrigado por qualquer ajuda!
Raylan Zibel

Raylan Zibel

Responder

Post mais votado

26/04/2016

Resolvido.

Raylan Zibel

Raylan Zibel
Responder

Mais Posts

05/04/2016

Raylan Zibel

Problema resolvido.

procedure TForm1.btn1Click(Sender: TObject);
var
  Sl: TStringList;
begin
  dlgOpen1.InitialDir := ExtractFileDir(Application.ExeName);
  if dlgOpen1.Execute then
    if FileExists(dlgOpen1.FileName) then
    begin
      // a tag width="200px" na tag img faz com que a imagem perca o tamanho ao ser carregada
      // então modifico essa propriedade pro editor pegar o tamanho normal da imagem
      // unica solução, até então...
      Sl := TStringList.Create;
      Sl.LoadFromFile(dlgOpen1.FileName);
      Sl.Text := StringReplace(Sl.Text, 'px"', '"', [rfReplaceAll]);
      Sl.SaveToFile(dlgOpen1.FileName);
      Sl.Free;
      // carregando pagina
      wprchtxtCorpo1.LoadFromFile(dlgOpen1.FileName, True, 'HTML');
    end;
end;

procedure TForm1.wprchtxtCorpo1RequestHTTPImage(RTFData: TWPRTFDataCollection; Reader: TWPCustomTextReader; const LoadPath, URL: string;
  TextObject: TWPTextObj; var Ok: Boolean);
var
  loadurl: string;
  jvIMG: TJvImage;
  Mst: TMemoryStream;
  IdHTTP1: TIdHTTP;
begin
  { uses JvExExtCtrls, JvImage, frxpngimage, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP; }
  if pos('http:', lowercase(URL)) > 0 then
  begin
    // se for uma url baixo pra MemoryStream
    loadurl := URL;
    Mst := TMemoryStream.Create;
    try
      IdHTTP1 := TIdHTTP.Create(nil);
      IdHTTP1.Get(URL, Mst);
      loadurl := ExtractFilePath(Application.ExeName) + 'tmp\img  ' + ExtractFileExt(URL);
      ForceDirectories(ExtractFileDir(loadurl));
      Mst.SaveToFile(loadurl);
    except

    end;
  end
  else
  begin
    // se estiver na pasta corrijo o path
    loadurl := LoadPath + URL;
    loadurl := StringReplace(loadurl, '/', '\', [rfReplaceAll]);
    loadurl := StringReplace(loadurl, '.\', '', [rfReplaceAll]);
    loadurl := UTF8Decode(loadurl);
  end;
  try
    // carrego imagem pro image pra dar load no TextObj do wpTools
    jvIMG := TJvImage.Create(nil);
    jvIMG.AutoSize := True;
    if FileExists(loadurl) then
      jvIMG.Picture.LoadFromFile(loadurl)
    else if Mst <> nil then
      if Mst.Size > 0 then
        jvIMG.Picture.Graphic.LoadFromStream(Mst);
  except

  end;
  try
    // carregando imagem do Graphic do image
    if jvIMG.Picture.Graphic <> nil then
    begin
      TextObject.LoadObjFromGraphic(jvIMG.Picture.Graphic);
      ok := TRUE;
    end;
  except

  end;
  // limpando
  IdHTTP1.Free;
  Mst.Free;
  jvIMG.Free;
end;
Responder

05/04/2016

Raylan Zibel

Obs.: Só falta funcionar com imagens em base64. Mas pode ser uma limitação da versão do componente.
Responder

08/04/2016

Raylan Zibel

Como alternativa, quando conteúdo é copiado direto do navegador:

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
uses
 ComObj
 
procedure TForm1.ColarConteudo
var
 WordApp: OleVariant
begin
 try
   // abro word
   WordApp := CreateOleObject('Word.Application')
   // deixo oculto
   WordApp.Visible := False
   // inicio documento vazio
   WordApp.Documents.Add
   // colo copiado da web
   WordApp.Selection.PasteAndFormat(wdFormatOriginalFormatting)
   // seleciono tudo
   WordApp.Selection.WholeStory
   // copio novamente
   WordApp.Selection.Copy
   // limpo documento
   wprchtxtCorpo1.ClearBody
   // colo copiado do word
   wprchtxtCorpo1.PasteFromClipboard
   // deleto conteudo selecionado no doc do word
   WordApp.Selection.Delete
   // fecho documento sem salvar
   WordApp.ActiveWindow.Close(wdDoNotSaveChanges)
 except
 end
 try
   // fecho word
   WordApp.Quit
 except
 end
end
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Responder

Assista grátis a nossa aula inaugural

Assitir aula

Saiba por que programar é uma questão de
sobrevivência e como aprender sem riscos

Assistir agora

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar