Delphi » Gotowce

Konwertownaie tekstu na HTML

paweb
unit Unit1; 

interface 

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

type 
 TKolorowanie = record 
  b, i, u: boolean; 
  color: tcolor; 
end; 

type 
 TForm1 = class(TForm) 
  ColorBox1: TColorBox; 
  RichEdit1: TRichEdit; 
  Button1: TButton; 
  procedure Button1Click(Sender: TObject); 
  private 
 public 
 end; 

var 
  Form1: TForm1; 

implementation 

{ $R *.dfm } 
function color2html(color: tcolor): string; 
begin 
  Result:='#' + IntToHex(GetRValue(color), 2) + 
   IntToHex(GetGValue(color), 2) + 
   IntToHex(GetBValue(color), 2); 
end; 

procedure openhtml(var s: string; k: tkolorowanie); 
begin 
  if k.b then s:=s + '<b>'; 
  if k.i then s:=s + '<i>'; 
  if k.u then s:=s + '<u>'; 
  s:=s + '<font color=' + color2html(k.color) + '>'; 
end; 

procedure closehtml(var s: string; k: tkolorowanie); 
begin 
  if k.b then s:=s + '</b>'; 
  if k.i then s:=s + '</i>'; 
  if k.u then s:=s + '</u>'; 
  s:=s + '</font>' 
end; 

function equal(a, b: tkolorowanie): boolean; 
begin 
  result:=(a.b = b.b) and (a.u = b.u) and (a.i = b.i) and (a.color = 
   b.color) 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
var 
  k, nk: tkolorowanie; 
  res: string; 
  i: Integer; 
  attr: TTextAttributes; 
begin 
  res:='<html><body>'; 
  richedit1.selstart:=1; 
  richedit1.sellength:=1; 
  attr:=richedit1.selattributes; 

  k.b:=fsBold in attr.Style; 
  k.u:=fsUnderline in attr.Style; 
  k.i:=fsItalic in attr.Style; 
  k.color:=attr.Color; 

  openhtml(res, k); 
  res:=res + richedit1.lines.text[1]; 

  for i:=2 to length(richedit1.lines.text) do begin 
   if richedit1.lines.text[i] = #10 then Continue; 
   if richedit1.lines.text[i] = #13 then begin 
    res:=res + '<br>'; 
    Continue 
   end; 

   richedit1.selstart:=i; 
   richedit1.sellength:=1; 
   attr:=richedit1.selattributes; 

   nk.b:=fsBold in attr.Style; 
   nk.u:=fsUnderline in attr.Style; 
   nk.i:=fsItalic in attr.Style; 
   nk.color:=attr.Color; 

   if not equal(nk, k) then begin 
    closehtml(res, k); 
    openhtml(res, nk); 
    k:=nk 
   end; 

   res:=res + richedit1.lines.text[i] 
  end; 

  closehtml(res, nk); 

  res:=res + '</body></html>'; 
  RichEdit1.Text:=res; 
end;

Trzeba wrzucić na formatkę Butona i RichEdit

Żeby zobaczyć efekt daj jeszcze jednego butona i pogrób nim tekst a następnie kliknij na Button1.

Podziękowania dla Vogel'a
/ który jest autorem kodu - mV :P /

Gotowce

2 komentarzy

ptr20

w jakiej zakładce jest komonent richedit ?

Deti

Trochę to naciągane :P