当更改某些非文本字符的字体时，如何使TRichEdit表现得像Windows7上的写字板？

在

Sertac Akyuz

的帮助下，直接原因似乎与

\bullet

的字符集有关：在我的本地化窗口中，通过键入Alt（0149）输入的

\bullet

总是得到

\fcharset134

，并且尝试通过

EM\u SETCHARFORMAT

更改其字体总是失败（当然，颜色、大小、样式确实可以更改，但字体系列名称不能更改）

因此，最简单的解决方法是首先重置字符集，然后更改字体

注意：应使用RichEdit（版本>=4.1）

注意：RichEdit版本可以在MSDN、Murray Sargent的MSDN博客和上找到。后面的页面提到了高于4.1的RichEdit版本。作为测试，我将Office 2010附带的RICHED20.DLL和应用程序复制到Windows 2000上，一切都很好

procedure TMainForm.ButtonFontClick(Sender: TObject);
var
  format: TCharFormat2;
begin
  if dlgFontCdxTxt.Execute then
  begin
    FillChar(format, sizeof(format), 0);
    format.cbSize:= Sizeof(format);
    format.dwMask:= CFM_CHARSET;
    format.bCharSet := 1; // or 0;
    redtTextBlock.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Integer(@format));

    FillChar(format, sizeof(format), 0);
    format.cbSize:= Sizeof(format);
    format.dwMask:= CFM_FACE;
    StrPLCopy(format.szFaceName, dlgFontCdxTxt.Font.Name, High(format.szFaceName));
    redtTextBlock.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Integer(@format));
  end;
  redtTextBlock.SetFocus;
end;

==================================================

据介绍，

WordPad

分别在Windows 95、98和Windows 2000中使用了Microsoft的

RichEdit

控件，版本分别为1.0、2.0和3.0。在Windows XP SP1和更高版本中，WordPad使用了RichEdit 4.1，包括Windows 7

假设在写字板中编辑的rtf文档包含非文本字符Alt（0149），

项目符号点•

（或U+2022）

在Windows 2000 SP4或XP SP2中，该圆点的字体只能采用写字板的默认字体。也就是说，不能在写字板中以交互方式更改该圆点的字体

但是，在Windows7SP1中，可以通过

先更改为“Arial Unicode MS”

，然后无限次更改为任何所需的字体来更改其字体

此外，在Windows7中使用写字板创建的包含不同字体点的写字板文档可以在Windows2000或XP中的写字板中正确打开和查看

TRichEdit（Delphi XE，Windows 7）还可以通过

TRichEdit.Lines.LoadFromFile

打开和查看在Windows 7中使用写字板创建的写字板文档

以交互方式，TRichEdit（Delphi XE，Windows 7）允许将圆点的字体更改为“Arial Unicode MS”。但是，不能在TRichEdit中进一步以交互方式更改为其他字体。

因此，我想知道（1）在Windows7中写字板行为不同的原因，（2）是否有可能使TRichEdit的行为相同

注：你可能需要多次键入Alt（0149）才能在写字板中获得点。按照建议，键入2022和Alt+x总是有效的

附言：你需要“激活”写字板中的字体，如答案中所述

附言：在Word中，可以随时将圆点更改为不同的字体

sample.rtf（粘贴到纯文本文件中，然后将扩展名更改为rtf以使用） uMainForm.dfm以查看TRichEdit行的格式 umaninform.pas以查看TRichEdit行的格式

unit；
接口
使用
继续，
窗口、消息、系统工具、变体、类、图形、控件、窗体、，
对话框、StdCtrls、ComCtrls、ExtCtrls；
类型
TCdxmlStyle=class
公众的
字体名称：字符串；
Str：字符串；
结束；
TCdxmlText=class
公众的
风格：TObjectList；
构造函数创建；
结束；
TMainForm=类（TForm）
redtTextBlock：TRichEdit；
mmo1:TMemo；
pnlBtn:TPanel；
PNL客户：TPanel；
按钮1:t按钮；
按钮2：t按钮；
dlgFontCdxTxt:TFontDialog；
程序按钮1点击（发送方：ToObject）；
程序按钮2点击（发送者：对象）；
过程表单创建（发送方：ToObject）；
私有的
{私有声明}
程序TestLoadFromFile；
程序分析编辑；
公众的
{公开声明}
结束；
变量
主要形式：TMA通知；
实施
{$R*.dfm}
使用
RichEdit，StrUtils；
{TCdxmlText}
构造函数TCdxmlText.Create；
开始
样式：=TObjectList.Create；
结束；
变量
l_HiddenRichEdit：TRichEdit；
{tma}
程序TMAInformCreate（发送方：ToObject）；
开始
TestLoadFromFile；
分析编辑；
结束；
程序TMainForm.按钮2点击（发送方：TObject）；
变量
格式：TCharFormat2；
开始
如果是dlgFontCdxTxt.Execute，则
开始
FillChar（格式，sizeof（格式），0）；
format.cbSize:=Sizeof（格式）；
格式.dwMask:=CFM_面；
StrPLCopy（format.szFaceName，dlgFontCdxTxt.Font.Name，High（format.szFaceName））；
执行（EM_SETCHARFORMAT，SCF_SELECTION，Integer（@format））；
结束；
redtTextBlock.SetFocus；
结束；
程序TMainForm.按钮1单击（发件人：ToObject）；
开始
分析编辑；
结束；
程序tmalinform.TestLoadFromFile；
开始
redtTextBlock。清除；
redtTextBlock.Lines.LoadFromFile（'sample.rtf'）；
结束；
程序TMainForm.AnalyzeRichEdit；
变量
l_MemStream:tmemorestream；
l_格式：TCharFormat2；
一、 J：整数；
l_CdxmlStyle，l_CdxmlStyleWorker:TCdxmlStyle；
l_StyleFont:string；
l_CdxmlText:TCdxmlText；
开始
l_CdxmlStyle:=nil；
l_CdxmlStyleWorker:=零；
mmo1.清晰；
l_MemStream:=TMemoryStream.Create；
redtTextBlock.Lines.SaveToStream（l_MemStream）；
l_MemStream.Seek（0，从开始）；
l_HiddenRichEdit.Lines.LoadFromStream（l_MemStream）；
l_CdxmlText:=TCdxmlText.Create；
对于I:=0到长度（TrimRight（l_HiddenRichEdit.Text））-1 do
开始
l_CdxmlStyleWorker:=TCdxmlStyle.Create；
FillChar（l_格式，sizeof（l_格式），0）；
l_格式.cbSize:=Sizeof（l_格式）；
l_格式.dwMask:=CFM_面；
l_HiddenRichEdit.SelStart:=I；
l_HiddenRichEdit.SelLength:=1；
l_HiddenRichEdit.Perform（EM_GETCHARFORMAT，SCF_SELECTION，Integer（@l_Format））；
l_CdxmlStyleWorker.FontName:=l_Format.szFaceName；
l_CdxmlStyleWorker.Str:=AnsiReplaceStr（l_HiddenRichEdit.SelText，#13，#13#10）；
如果l_CdxmlStyle=nil，则
开始
l_CdxmlText.Styles.Add（l_CdxmlStyleWorker）；
l_CdxmlStyle:=l_CdxmlStyleWorker；
结束
else if（l_CdxmlStyleWorker.FontNa
{\rtf1\ansi\ansicpg936\deff0\deflang1033\deflangfe2052{\fonttbl{\f0\fswiss\fprq2\fcharset134 Arial Unicode MS;}{\f1\fnil\fcharset0 Arial Unicode MS;}{\f2\froman\fprq2\fcharset0 Times New Roman;}{\f3\fscript\fprq2\fcharset0 Comic Sans MS;}{\f4\fnil\fcharset0 Comic Sans MS;}{\f5\fmodern\fprq1\fcharset0 Consolas;}{\f6\fnil\fcharset0 Consolas;}{\f7\fmodern\fprq1\fcharset0 Lucida Console;}{\f8\fnil\fcharset0 Lucida Console;}{\f9\froman\fprq2\fcharset2 Symbol;}{\f10\froman\fprq2\fcharset0 Symbol;}{\f11\fnil\fcharset134 \'cb\'ce\'cc\'e5;}}
{\*\generator Msftedit 5.41.21.2510;}\viewkind4\uc1\pard\nowidctlpar\sa200\sl276\slmult1\lang2052\f0\fs22 Arial sample text \lang1033\f1\bullet\f2\par
\b\f3 Comic sample text \f4\bullet\f2\par
\b0\f5 Consolas sample text \f6\bullet\f2\par
\f7 Lucida sample text \f8\bullet\f2\par
\pard\nowidctlpar\qj\lang2052\f9 symbl sample text \lang1033\f10\u149?\kerning2\fs21\par
\pard\sa200\sl276\slmult1\lang2052\kerning0\f11\fs22\par
}

object MainForm: TMainForm
  Left = 0
  Top = 0
  Caption = 'MainForm'
  ClientHeight = 362
  ClientWidth = 637
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object pnlBtn: TPanel
    Left = 0
    Top = 0
    Width = 637
    Height = 57
    Align = alTop
    Caption = 'pnlBtn'
    TabOrder = 0
    object Button1: TButton
      Left = 240
      Top = 14
      Width = 137
      Height = 31
      Caption = 'Analyze Rich Edit'
      TabOrder = 0
      OnClick = Button1Click
    end
  end
  object pnlClient: TPanel
    Left = 0
    Top = 57
    Width = 637
    Height = 305
    Align = alClient
    Caption = 'pnlClient'
    TabOrder = 1
    object redtTextBlock: TRichEdit
      Left = 1
      Top = 1
      Width = 225
      Height = 303
      Align = alLeft
      Font.Charset = GB2312_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Tahoma'
      Font.Style = []
      Lines.Strings = (
        'redt1')
      ParentFont = False
      TabOrder = 0
    end
    object mmo1: TMemo
      Left = 226
      Top = 1
      Width = 410
      Height = 303
      Align = alClient
      Lines.Strings = (
        'mmo1')
      TabOrder = 1
    end
  end
  object Button2: TButton
    Left = 36
    Top = 14
    Width = 171
    Height = 31
    Caption = 'Font...'
    TabOrder = 2
    OnClick = Button2Click
  end
  object dlgFontCdxTxt: TFontDialog
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Tahoma'
    Font.Style = []
    Left = 480
    Top = 16
  end
end

unit uMainForm;

interface

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

type

  TCdxmlStyle = class
  public
    FontName: string;
    Str: string;
  end;

  TCdxmlText = class
  public
    Styles: TObjectList;
    constructor Create;
  end;

  TMainForm = class(TForm)
    redtTextBlock: TRichEdit;
    mmo1: TMemo;
    pnlBtn: TPanel;
    pnlClient: TPanel;
    Button1: TButton;
    Button2: TButton;
    dlgFontCdxTxt: TFontDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure TestLoadFromFile;
    procedure AnalyzeRichEdit;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

uses
  RichEdit, StrUtils;

{ TCdxmlText }

constructor TCdxmlText.Create;
begin
  Styles := TObjectList.Create;
end;

var
  l_HiddenRichEdit: TRichEdit;

{ TMainForm }

procedure TMainForm.FormCreate(Sender: TObject);
begin
  TestLoadFromFile;
  AnalyzeRichEdit;
end;

procedure TMainForm.Button2Click(Sender: TObject);
var
  format: TCharFormat2;
begin
  if dlgFontCdxTxt.Execute then
  begin
    FillChar(format, sizeof(format), 0);
    format.cbSize:= Sizeof(format);
    format.dwMask:= CFM_FACE;

    StrPLCopy(format.szFaceName, dlgFontCdxTxt.Font.Name, High(format.szFaceName));

    redtTextBlock.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Integer(@format));
  end;
  redtTextBlock.SetFocus;
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
  AnalyzeRichEdit;
end;

procedure TMainForm.TestLoadFromFile;
begin
  redtTextBlock.Clear;

  redtTextBlock.Lines.LoadFromFile('sample.rtf');
end;

procedure TMainForm.AnalyzeRichEdit;
var
  l_MemStream: TMemoryStream;
  l_Format: TCharFormat2;

  I, J: Integer;
  l_CdxmlStyle, l_CdxmlStyleWorker: TCdxmlStyle;
  l_StyleFont: string;

  l_CdxmlText: TCdxmlText;
begin
  l_CdxmlStyle := nil;
  l_CdxmlStyleWorker := nil;

  mmo1.Clear;

  l_MemStream := TMemoryStream.Create;
  redtTextBlock.Lines.SaveToStream(l_MemStream);
  l_MemStream.Seek(0, soFromBeginning);
  l_HiddenRichEdit.Lines.LoadFromStream(l_MemStream);

  l_CdxmlText := TCdxmlText.Create;
  for I := 0 to Length(TrimRight(l_HiddenRichEdit.Text)) - 1 do
  begin
    l_CdxmlStyleWorker := TCdxmlStyle.Create;

    FillChar(l_Format, sizeof(l_Format), 0);
    l_Format.cbSize:= Sizeof(l_Format);
    l_Format.dwMask:= CFM_FACE;

    l_HiddenRichEdit.SelStart := I;
    l_HiddenRichEdit.SelLength := 1;
    l_HiddenRichEdit.Perform(EM_GETCHARFORMAT, SCF_SELECTION, Integer(@l_Format));

    l_CdxmlStyleWorker.FontName := l_Format.szFaceName;

    l_CdxmlStyleWorker.Str := AnsiReplaceStr(l_HiddenRichEdit.SelText, #13, #13#10);

    if l_CdxmlStyle = nil then
    begin
      l_CdxmlText.Styles.Add(l_CdxmlStyleWorker);
      l_CdxmlStyle := l_CdxmlStyleWorker;
    end
    else if (l_CdxmlStyleWorker.FontName  <> l_CdxmlStyle.FontName ) then
    begin
      l_CdxmlText.Styles.Add(l_CdxmlStyleWorker);
      l_CdxmlStyle := l_CdxmlStyleWorker;
    end
    else
    begin
      l_CdxmlStyle.Str := l_CdxmlStyle.Str + l_CdxmlStyleWorker.Str;
    end;
  end;

  for I := 0 to l_CdxmlText.Styles.Count - 1 do
  begin
    l_CdxmlStyle := TCdxmlStyle(l_CdxmlText.Styles[I]);
    mmo1.Lines.Add(l_CdxmlStyle.Str + ':' + l_CdxmlStyle.FontName);
  end;
end;

initialization

  l_HiddenRichEdit := TRichEdit.CreateParented(HWND_MESSAGE);

end.