简单的HTML显示处理

procedure DrawHTML(r: TRect; aCanvas: TCanvas; const text: string);

var

 p: PChar;

 c: Char;

 x, y, w, wc, hc: Integer;

 code: string;

begin

 p := PChar(text);

 x := r.Left;

 y := r.Top;

 hc := aCanvas.TextHeight('Ag');

 if p <> nil then

   while p^ <> #0 do

   begin

     c := p^;

     if c = '<' then

     begin

       code := '';

       inc(p);

       while (p^ <> '>') and (p^ <> #0) do

       begin

         code := code + uppercase(p^);

         inc(p);

       end;

       if code = 'B' then

         aCanvas.Font.Style :=

             aCanvas.Font.Style + [fsBold]

       else if code = 'I' then

         aCanvas.Font.Style :=

             aCanvas.Font.Style + [fsItalic]

       else if code = 'U' then

         aCanvas.Font.Style :=

             aCanvas.Font.Style + [fsUnderline]

       else if code = '/B' then

         aCanvas.Font.Style :=

             aCanvas.Font.Style - [fsBold]

       else if code = '/I' then

         aCanvas.Font.Style :=

             aCanvas.Font.Style - [fsItalic]

       else if code = '/U' then

         aCanvas.Font.Style :=

             aCanvas.Font.Style - [fsUnderline];

     end

     else if c = #10 then

     begin

       x := r.Left;

       inc(y, hc);

     end

     else if c >= #32 then

     begin

       wc := aCanvas.TextWidth(c);

       if x + wc > r.Right then

       begin

x := r.Left; inc(y, hc);

       end;

       if y + hc < r.Bottom then

         aCanvas.TextOut(x, y, c);

       inc(x, wc);

     end;

     if p^>#0 then inc(p);

   end;

end;