你可能会说在 stackOverflow 中有很多关于这个的讨论，但大多数都比我需要的更复杂，而且主要是针对其他语言的。
我有一个 MySQL 远程数据库，其中有一个“帮助”表，其中包含用于填充使用该数据库的动态网站的帮助页面的代码。
我决定制作一个 Delphi 应用程序来管理该网站，而不是由网站本身来管理，以提高速度和安全性。
我想添加一个TRichEdit帮助文本并使用简单的东西，如对齐、粗体、斜体和下划线样式。我不想使用图片和字体。
如何选择富样式文本并将其转换为 HTML以放入远程数据库中的 BLOB 字段，然后如果我想再次编辑它又重新转换为富文本？
如果您真的想使用 生成 RTF 内容TRichEdit，那么您应该将它生成的本机 RTF 与转换后的 HTML 一起存储。如果您使用的唯一原因TRichEdit是您可以拥有简单的格式化功能，那么您最好使用生成本机 HTML 内容的 HTML 编辑控件。
不管你走哪条路，最好存储原生格式供用户编辑内容，并根据需要将其转换为其他格式（而不是双向转换）。
如果您使用TRichEdit，那么您可以轻松地将 RTF 内容流式传输进出控件，尽管我建议您使用TJvRichEdit以下方法TRichEdit：
procedure GetRTFData(MS: TMemoryStream; RTF: TRichEdit);
begin
MS.Clear;
RTF.Lines.SaveToStream(MS);
MS.Position := 0;
end;
procedure SetRTFData(MS: TMemoryStream; RTF: TRichEdit);
begin
MS.Position := 0;
RTF.StreamFormat := sfRichText;
RTF.Lines.LoadFromStream(MS);
end;
手动将 RTF 转换为 HTML 并非易事。有 unicode 字符注意事项、字体样式、字体代码、段落格式、编号列表、特殊 HTML 字符等等。即使您只需要支持简单的格式设置，用户也经常使用其他导致转换问题的功能——例如从 MSWord 复制内容并将其粘贴到您的应用中，并使用各种格式和字体样式。
JvRichEditToHtml在将 RTF 转换为 HTML 方面做得不错，但我们最终编写了自己的转换单元，因为我们用 RTF 做的比简单的格式化要多得多。 JvRichEditToHtml只要用户不通过复制/粘贴来引入复杂的内容，或者使用键盘快捷键格式化内容（例如，项目符号 = ctrl+shft+L、缩进 = ctrl+M、 ETC。）。
如果您想绕过在 RTF 中编写和转换为 HTML 的复杂性，还有几个很好的 Delphi HTML 编辑控件：
Google 结果 :: Delphi、HTML、编辑器、组件
Stack Overflow :: Delphi、HTML、编辑器、组件
我们使用TRichView它是因为它具有广泛的功能。它可以加载/创建 RTF，并导出 HTML。然而它不是免费的。如果您正在寻找免费的东西，TJvRichView并且JvRichEditToHtml是不错的选择。
在尝试了许多没有给出准确结果的不同解决方案之后，我受到了这个解决方案的启发：Convert RTF to HTML and HTML to RTF。
这个想法是TWebBrowser控件（在设计/编辑模式下）可以在从剪贴板粘贴时正确处理和转换富文本格式。
uses SHDocVw, MSHTML;
function ClipboardToHTML(AParent: TWinControl): WideString;
var
wb: TWebBrowser;
function WaitDocumentReady: Boolean;
var
StartTime: DWORD;
begin
StartTime := GetTickCount;
while wb.ReadyState <> READYSTATE_COMPLETE do
begin
Application.HandleMessage;
if GetTickCount >= StartTime + 2000 then // time-out of max 2 sec
begin
Result := False; // time-out
Exit;
end;
end;
Result := True;
end;
begin
Result := '';
wb := TWebBrowser.Create(nil);
try
wb.Silent := True;
wb.Width := 0;
wb.Height := 0;
wb.Visible := False;
TWinControl(wb).Parent := AParent;
wb.HandleNeeded;
if wb.HandleAllocated then
begin
wb.Navigate('about:blank');
(wb.Document as IHTMLDocument2).designMode := 'on';
if WaitDocumentReady then
begin
(wb.Document as IHTMLDocument2).execCommand('Paste', False, 0);
Result := (wb.Document as IHTMLDocument2).body.innerHTML;
end;
end;
finally
wb.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
RichEdit1.SelectAll;
RichEdit1.CopyToClipboard;
ShowMessage(ClipboardToHTML(Self));
end;
这对我来说真的很好。没有 TWebBrowser。
但从html到richedit。
希望有人觉得它有用。
////////////////////////////////////////////////////////
// //
// Formatting Richedit with HTML tags //
// by Carbonize //
// //
// This is my second Delphi project and another //
// conversion of one of my Visual Basic codes. //
// //
// This code goes through a string looking for //
// <xxx> style tags then formats the richedit //
// according to the text in the tag. It does //
// colours, italics, bold, underline, line breaks, //
// font face, and font size. //
// //
// I made the original VB version as a way of //
// formatting the help files in one of my programs //
// to make them look better and be easier to read. //
// //
// Please remember I am new to Delphi so some //
// of the code may be sloppy. When handling //
// <Font tags I did it the long way so it could //
// handle tags with spaces between the 'face' or //
// 'size' and the actual face/size such as //
// <font name = "Comic Sans MS"> as some people //
// do their HTML this way. //
// //
////////////////////////////////////////////////////////
// //
// Monday, 27th January 2003 //
// //
////////////////////////////////////////////////////////
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls;
type
TForm1 = class(TForm)
txtHTML: TMemo;
Button1: TButton;
rchHTML: TRichEdit;
procedure Button1Click(Sender: TObject);
procedure DisplayText(Tag: string; Buf:string);
procedure FontTags(Tag: string; Buf:string);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
Buf : string;
Bumf : string;
tag : string;
begin
//Clear the Richedit and set default formatting
rchHTML.text := '';
rchHTML.SelAttributes.style := [];
rchHTML.selattributes.color := clBlack;
rchHTML.SelAttributes.Name := 'MS Sans Serif';
rchHTML.SelAttributes.Size := 8;
//strip all new line commands as it screws the code up.
Bumf := stringreplace(txtHTML.Text, #13#10, '', [rfReplaceAll]);
//if there's no '<' then there's no tags so display whole string.
if pos('<', Bumf) = 0 then
begin //but first convert any <> replacement strings.
Bumf := stringreplace(Bumf, '<', '<', [rfReplaceAll]);
Bumf := stringreplace(Bumf, '>', '>', [rfReplaceAll]);
Bumf := stringreplace(Bumf, '&', '&', [rfReplaceAll]);
rchHTML.SelText := Bumf;
exit;
end;
//else thats display all text before the '<'.
//But first convert any replacements that are in there.
Buf := copy(Bumf, 0, pos('<', Bumf) - 1);
Buf := stringreplace(Buf, '<', '<', [rfReplaceAll]);
Buf := stringreplace(Buf, '>', '>', [rfReplaceAll]);
Buf := stringreplace(Buf, '&', '&', [rfReplaceAll]);
rchHTML.SelText := Buf;
//then strip all text before the '<'
delete(Bumf, 1 ,pos('<', Bumf) - 1);
//If there's no '>' then it's not a tag so just post it all
If pos('>', Bumf) = 0 then
begin
rchHTML.SelText := Bumf;
exit;
end;
//else we need to parse any and all tags and the strings to post
While length(Bumf) > 0 do
begin
//the tag := all text between '<' and '>'
Tag := copy(Bumf, 2, pos('>', Bumf) - 2);
//the text we will post is everything after the '>'
Buf := copy(Bumf, pos('>', Bumf) + 1, length(Bumf) - pos('>', Bumf));
//Empty Bumf
Bumf := '';
//Are there any '<'s in the tag?
while pos('<', tag) > 0 do
begin //if so then post all text before the'<' as it's not part of a tag
rchhtml.SelText := '<' + copy(Tag, 1, pos('<', Tag) - 1);
//tag then := all text from the '<'
Tag := copy(Tag, pos('<', Tag) + 1, length(Tag) - pos('<', Tag));
End;
//if there's a '<' in Buf then there may be another Tag
If pos('<', Buf) > 0 then
begin //So we make Bumf := everything after the '<'
Bumf := copy(Buf, pos('<', Buf), (length(Buf) - pos('<', Buf)) + 1);
//And buf := everything before it
Buf := copy(Buf, 1, pos('<', Buf) - 1);
end;
//now we pass the tag and the buf text to our text formatting procedure
DisplayText(Tag, Buf);
end;
end;
procedure TForm1.DisplayText(Tag: string; Buf:string);
begin
//There is a problem where if buf = '' the richedit attributes didn't get set
//so I included this shoddy fix.
//If you know why this bug happens please let me know.
If Buf = '' then Buf := #12;
//in case we want to actually show a tag or the markers used for < and >
Buf := stringreplace(Buf, '<', '<', [rfReplaceAll]);
Buf := stringreplace(Buf, '>', '>', [rfReplaceAll]);
Buf := stringreplace(Buf, '&', '&', [rfReplaceAll]);
Tag := stringreplace(Tag, '<', '<', [rfReplaceAll]);
Tag := stringreplace(Tag, '>', '>', [rfReplaceAll]);
Tag := stringreplace(Tag, '&', '&', [rfReplaceAll]);
//if it's a font tag then send it to font handling
If copy(lowercase(Tag), 0, 5) = 'font ' then
begin
FontTags(Tag, Buf);
exit;
end;
//go through all known tags, formatting richedit as appropriate
if lowercase(Tag) = 'red' then
rchHTML.SelAttributes.Color := clRed
else if lowercase(Tag) = 'black' then
rchHTML.SelAttributes.Color := clBlack
else if lowercase(Tag) = 'blue' then
rchHTML.SelAttributes.Color := clBlue
else if lowercase(Tag) = 'cyan' then
rchHTML.SelAttributes.Color := clAqua
else if ((lowercase(Tag) = 'gray') or (lowercase(Tag) = 'grey')) then
rchHTML.SelAttributes.Color := clGray
else if lowercase(Tag) = 'green' then
rchHTML.SelAttributes.Color := clGreen
else if lowercase(Tag) = 'pink' then
rchHTML.SelAttributes.Color := clFuchsia
else if lowercase(Tag) = 'purple' then
rchHTML.SelAttributes.Color := clPurple
else if lowercase(Tag) = 'yellow' then
rchHTML.SelAttributes.Color := clYellow
else if lowercase(Tag) = 'b' then
rchHTML.SelAttributes.Style := rchHTML.SelAttributes.Style + [fsBold]
else if lowercase(Tag) = '/b' then
rchHTML.SelAttributes.Style := rchHTML.SelAttributes.Style - [fsBold]
else if lowercase(Tag) = 'i' then
rchHTML.SelAttributes.Style := rchHTML.SelAttributes.Style + [fsItalic]
else if lowercase(Tag) = '/i' then
rchHTML.SelAttributes.Style := rchHTML.SelAttributes.Style - [fsItalic]
else if lowercase(Tag) = 'u' then
rchHTML.SelAttributes.Style := rchHTML.SelAttributes.Style + [fsUnderline]
else if lowercase(Tag) = '/u' then
rchHTML.SelAttributes.Style := rchHTML.SelAttributes.Style - [fsUnderline]
else if lowercase(Tag) = 'br' then
Buf := #13#10 + Buf
//If it's an unknown tag then display the tag
else Buf := '<' + Tag + '>' + Buf;
//Now we've set the attributes we can display the text.
rchHTML.SelText := Buf;
end;
procedure TForm1.FontTags(Tag: string; Buf:string);
var
a: integer;
tag2: String;
begin
//we know it's a font tag so strip the 'font '
Delete(Tag, 1, 5);
//lets see if the want to set the font face
If pos('face', lowercase(Tag)) > 0 then
begin //get the position of 'face'
a := pos('face', lowercase(Tag));
//set our temporary string to := all text from 'face' to the end.
tag2 := copy(Tag, a, length(Tag) - (a - 1));
//Then get position of the opening".
a := pos('"', Tag2) + 1;
//set our temporary string to := all text from " + 1 to the end.
Tag2 := copy(Tag2, a, length(Tag2) - (a - 1));
//Then locate the closing "
a := pos('"', Tag2) - 1;
//then make tag2 = the text between " and "
Tag2 := copy(Tag2, 1, a);
//Now set the font name to the chosen one.
rchHTML.SelAttributes.Name := Tag2;
end;
//Now check if they want to set the fonts size.
If pos('size', lowercase(Tag)) > 0 then
begin //get the position of 'size'
a := pos('size', lowercase(Tag));
//Make temporary string := all text from 'size' to end of the tag
tag2 := copy(Tag, a, length(Tag) - (a - 1));
//get position of opening "
a := pos('"', Tag2) + 1;
//make tag2 := all text from " + 1 to the end.
Tag2 := copy(Tag2, a, length(Tag2) - (a - 1));
//get position of the closing "
a := pos('"', Tag2) - 1;
//make tag2 := text between " and "
Tag2 := copy(Tag2, 1, a);
//set the fonts size
rchHTML.SelAttributes.Size := strtoint(Tag2);
end;
//Now we've formatted we can display the text.
rchHTML.seltext := Buf;
end;
end.