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

Componente

Corposemalma

Perguntado por Corposemalma,

 Share

Pergunta

Corposemalma

Corposemalma

Postado
Postado

Alguém conhece algum componente (ou maneira) que seja capaz de tranformar HTML em RTF, estive procurando bastante tempo no google pelo mesmo e somente consegui um componente que transforma RTF em HTML...

Ou melhor: algum site que contenha componentes diversos (de preferencia Free)...

Já dei uma olhada nos:

http://www.activedelphi.com.br <- não achei nada do tipo

http://www.delphi.eti.br <- está fora do ar

Só estou pedindo por que não achei em lugar algum... wink.gif

Valeu! smile.gif

Link para o comentário
Compartilhar em outros sites

3 respostass a esta questão

Posts Recomendados

  • 0
Corposemalma

Corposemalma

Postado
  • Autor
Postado

Ae Bolo! Achei uma Procedure que faz o serviço... Fiz uns testes(bem básicos) e ela dá suporte ao básico do Html....

Estava em um fórum de Delphi, então acho que deve ser Free não?

Pra não ter que enviar pra cada um por email, aqui vai:

(Mas se for útil pra quem pegar ela, deixa uma mensagem ai, pra gente saber! laugh.gif)

Tomara que funcione... não quero mexer nesse código ai... (Tá em alemão os nomes e comentário ohmy.gif )

Se alguma alma caridosa quiser traduzir pra gente tongue.gif

procedure HTMLtoRTF(html: string; var rtf: TRichedit);

var

  i, dummy, row: Integer;

  cfont: TFont; { Standard sschrift }

  Tag, tagparams: string;

  params: TStringList;

  function GetTag(s: string; var i: Integer; var Tag, tagparams: string): Boolean;

  var 

    a_tag: Boolean;

  begin

    GetTag  := False;

    Tag  := '';

    tagparams := '';

    a_tag  := False;

    while i <= Length(s) do 

    begin

      Inc(i);

      // es wird nochein tag geöffnet --> das erste war kein tag;

      if s = '<' then 

      begin

        GetTag := False;

        Exit;

      end;

      if s = '>' then 

      begin

        GetTag := True;

        Exit;

      end;

      if not a_tag then 

      begin

        if s = ' ' then 

        begin

          if Tag <> '' then a_tag := True;

        end 

        else 

          Tag := Tag + s;

      end 

      else

        tagparams := tagparams + s;

    end;

  end;

  procedure GetTagParams(tagparams: string; var params: TStringList);

  var 

    i: Integer;

    s: string;

    gleich: Boolean;

    // kontrolliert ob nach dem zeichen bis zum nächsten zeichen ausser

    // leerzeichen ein Ist-Gleich-Zeichen kommt

    function notGleich(s: string; i: Integer): Boolean;

    begin

      notGleich := True;

      while i <= Length(s) do 

      begin

        Inc(i);

        if s = '= then 

        begin

          notGleich := False;

          Exit;

        end 

        else if s <> ' ' then Exit;

      end;

    end;

  begin

    Params.Clear;

    s := '';

    for i := 1 to Length(tagparams) do 

    begin

      if (tagparams <> ' ') then 

      begin

        if tagparams <> '=' then gleich := False;

        if (tagparams <> '''') and (tagparams <> '"') then s := s + tagparams

      end 

      else 

      begin

        if (notGleich(tagparams, i)) and (not Gleich) then 

        begin

          params.Add(s);

          s := '';

        end 

        else 

          Gleich := True;

      end;

    end;

    params.Add(s);

  end;

  function HtmlToColor(Color: string): TColor;

  begin

    Result := StringToColor('$' + Copy(Color, 6, 2) + Copy(Color, 4,

      2) + Copy(Color, 2, 2));

  end;

  procedure TransformSpecialChars(var s: string; i: Integer);

  var 

    c: string;

    z, z2: Byte;

    i2: Integer;

  const 

    nchars = 9;

    chars: array[1..nchars, 1..2] of string =

      (('Ö', 'Ö'), ('ö', 'ö'), ('Ä', 'Ä'), ('ä', 'ä'),

      ('Ü', 'Ü'), ('ü', 'ü'), ('ß', 'ß'), ('<', '<'),

      ('>', '>'));

  begin

    // Maximal die nächsten 7 zeichen auf sonderzeichen überprüfen

    c  := '';

    i2 := i;

    for z := 1 to 7 do 

    begin

      c := c + s[i2];

      for z2 := 1 to nchars do 

      begin

        if chars[z2, 1] = c then 

        begin

          Delete(s, i, Length©);

          Insert(chars[z2, 2], s, i);

          Exit;

        end;

      end;

      Inc(i2);

    end;

  end;

  // HtmlTag Schriftgröße in pdf größe umwandeln

  function CalculateRTFSize(pt: Integer): Integer;

  begin

    case pt of

      1: Result := 6;

      2: Result := 9;

      3: Result := 12;

      4: Result := 15;

      5: Result := 18;

      6: Result := 22;

      else 

        Result := 30;

    end;

  end;

  // Die Font-Stack Funktionen

type 

  fontstack = record

    Font: array[1..100] of tfont;

    Pos: Byte;

  end;

  procedure CreateFontStack(var s: fontstack);

  begin

    s.Pos := 0;

  end;

  procedure PushFontStack(var s: Fontstack; fnt: TFont);

  begin

    Inc(s.Pos);

    s.Font[s.Pos] := TFont.Create;

    s.Font[s.Pos].Assign(fnt);

  end;

  procedure PopFontStack(var s: Fontstack; var fnt: TFont);

  begin

    if (s.Font[s.Pos] <> nil) and (s.Pos > 0) then 

    begin

      fnt.Assign(s.Font[s.Pos]);

      // vom stack nehmen

      s.Font[s.Pos].Free;

      Dec(s.Pos);

    end;

  end;

  procedure FreeFontStack(var s: Fontstack);

  begin

    while s.Pos > 0 do 

    begin

      s.Font[s.Pos].Free;

      Dec(s.Pos);

    end;

  end;

var 

  fo_cnt: array[1..1000] of tfont;

  fo_liste: array[1..1000] of Boolean;

  fo_pos: TStringList;

  fo_stk: FontStack;

  wordwrap, liste: Boolean;

begin

  CreateFontStack(fo_Stk);

  fo_Pos := TStringList.Create;

  rtf.Lines.BeginUpdate;

  rtf.Lines.Clear;

  // Das wordwrap vom richedit merken

  wordwrap  := rtf.wordwrap;

  rtf.WordWrap := False;

  // erste Zeile hinzufügen

  rtf.Lines.Add('');

  Params := TStringList.Create;

  cfont := TFont.Create;

  cfont.Assign(rtf.Font);

  i := 1;

  row := 0;

  Liste := False;

  // Den eigentlichen Text holen und die Formatiorung merken

  rtf.selstart := 0;

  if Length(html) = 0 then Exit;

  repeat;

    if html = '<' then 

    begin

      dummy := i;

      GetTag(html, i, Tag, tagparams);

      GetTagParams(tagparams, params);

      // Das Font-Tag

      if Uppercase(Tag) = 'FONT' then 

      begin

        // Schrift auf fontstack sichern

        pushFontstack(fo_stk, cfont);

        if params.Values['size] <> '' then

          cfont.Size := CalculateRTFSize(StrToInt(params.Values['size']));

        if params.Values['color'] <> '' then cfont.Color :=

            htmltocolor(params.Values['color']);

      end 

      else if Uppercase(Tag) = '/FONT' then  popFontstack(fo_stk, cfont) 

      else // Die H-Tags-Überschriften

      if Uppercase(Tag) = 'H1' then 

      begin

        // Schrift auf fontstack sichern

        pushFontstack(fo_stk, cfont);

        cfont.Size := 6;

      end 

      else if Uppercase(Tag) = '/H1' then  popFontstack(fo_stk, cfont) 

      else // Die H-Tags-Überschriften

      if Uppercase(Tag) = 'H2' then 

      begin

        // Schrift auf fontstack sichern

        pushFontstack(fo_stk, cfont);

        cfont.Size := 9;

      end 

      else if Uppercase(Tag) = '/H2' then  popFontstack(fo_stk, cfont) 

      else // Die H-Tags-Überschriften

      if Uppercase(Tag) = 'H3' then 

      begin

        // Schrift auf fontstack sichern

        pushFontstack(fo_stk, cfont);

        cfont.Size := 12;

      end 

      else if Uppercase(Tag) = '/H3' then  popFontstack(fo_stk, cfont) 

      else // Die H-Tags-Überschriften

      if Uppercase(Tag) = 'H4' then 

      begin

        // Schrift auf fontstack sichern

        pushFontstack(fo_stk, cfont);

        cfont.Size := 15;

      end 

      else if Uppercase(Tag) = '/H4' then  popFontstack(fo_stk, cfont) 

      else // Die H-Tags-Überschriften

      if Uppercase(Tag) = 'H5' then 

      begin

        // Schrift auf fontstack sichern

        pushFontstack(fo_stk, cfont);

        cfont.Size := 18;

      end 

      else if Uppercase(Tag) = '/H5' then  popFontstack(fo_stk, cfont) 

      else // Die H-Tags-Überschriften

      if Uppercase(Tag) = 'H6' then 

      begin

        // Schrift auf fontstack sichern

        pushFontstack(fo_stk, cfont);

        cfont.Size := 22;

      end 

      else if Uppercase(Tag) = '/H6' then  popFontstack(fo_stk, cfont) 

      else // Die H-Tags-Überschriften

      if Uppercase(Tag) = 'H7' then 

      begin

        // Schrift auf fontstack sichern

        pushFontstack(fo_stk, cfont);

        cfont.Size := 27;

      end 

      else if Uppercase(Tag) = '/H7' then  popFontstack(fo_stk, cfont) 

      else // Bold-Tag

      if Uppercase(Tag) = 'B' then cfont.Style := cfont.Style + [fsbold] 

      else if Uppercase(Tag) = '/B' then cfont.Style := cfont.Style - [fsbold] 

      else // Italic-Tag

      if Uppercase(Tag) = 'I' then cfont.Style := cfont.Style + [fsitalic] 

      else if Uppercase(Tag) = '/I' then cfont.Style := cfont.Style - [fsitalic] 

      else // underline-Tag

      if Uppercase(Tag) = 'U' then cfont.Style := cfont.Style + [fsunderline] 

      else if Uppercase(Tag) = '/U' then cfont.Style := cfont.Style - [fsunderline] 

      else // underline-Tag

      if Uppercase(Tag) = 'UL' then liste := True 

      else if Uppercase(Tag) = '/UL' then 

      begin

        liste := False;

        rtf.Lines.Add('');

        Inc(row);

        rtf.Lines.Add('');

        Inc(row);

      end 

      else // BR - Breakrow tag

      if (Uppercase(Tag) = 'BR') or (Uppercase(Tag) = 'LI') then 

      begin

        rtf.Lines.Add('');

        Inc(row);

      end;

      // unbekanntes tag als text ausgeben

      // else rtf.Lines[row]:=RTF.lines[row]+'<'+tag+' '+tagparams+'>';

      fo_pos.Add(IntToStr(rtf.selstart));

      fo_cnt[fo_pos.Count] := TFont.Create;

      fo_cnt[fo_pos.Count].Assign(cfont);

      fo_liste[fo_pos.Count] := liste;

    end 

    else 

    begin

      // Spezialzeichen übersetzen

      if html = '&' then Transformspecialchars(html, i);

      if (Ord(html) <> 13) and (Ord(html) <> 10) then

        rtf.Lines[row] := RTF.Lines[row] + html;

    end;

    Inc(i);

  until i >= Length(html);

  // dummy eintragen

  fo_pos.Add('999999');

  // Den fertigen Text formatieren

  for i := 0 to fo_pos.Count - 2 do 

  begin

    rtf.SelStart := StrToInt(fo_pos);

    rtf.SelLength := StrToInt(fo_pos[i + 1]) - rtf.SelStart;

    rtf.SelAttributes.Style := fo_cnt[i + 1].Style;

    rtf.SelAttributes.Size := fo_cnt[i + 1].Size;

    rtf.SelAttributes.Color := fo_cnt[i + 1].Color;

    // die font wieder freigeben;

    fo_cnt[i + 1].Free;

  end;

  // die Paragraphen also Listen setzen

  i := 0;

  while i <= fo_pos.Count - 2 do 

  begin

    if fo_liste[i + 1] then 

    begin

      rtf.SelStart := StrToInt(fo_pos[i + 1]);

      while fo_liste[i + 1] do Inc(i);

      rtf.SelLength := StrToInt(fo_pos[i - 1]) - rtf.SelStart;

      rtf.Paragraph.Numbering := nsBullet;

    end;

    Inc(i);

  end;

  rtf.Lines.EndUpdate;

  Params.Free;

  cfont.Free;

  rtf.WordWrap := wordwrap;

  FreeFontStack(fo_stk);

end;

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...