RichEdit – 蓝天白云

uses RichEdit;

1. 设置RichEdit的行间距，代码如下

procedure TForm1.Button3Click(Sender: TObject);
var
  pf: PARAFORMAT2;
begin
  FillChar(pf, sizeof(paraformat2), #0);
  pf.cbSize := SizeOf(paraformat2);
  pf.dwMask := PFM_LINESPACING  ;   //需要设置上 PFM_LINESPACING 标志，bLineSpacingRule和dyLineSpacing才可能有效

//  pf.bLineSpacingRule := 0;   //单倍行距，dyLineSpacing的值将被忽略
//  pf.bLineSpacingRule := 1;   //1.5倍行距，dyLineSpacing的值将被忽略
//  pf.bLineSpacingRule := 2;   //两倍行距，dyLineSpacing的值将被忽略
//  pf.bLineSpacingRule := 3;   //用dyLineSpacing以缇为单位指定行间距，当此值小于单倍行距时，效果为单倍行距
//  pf.bLineSpacingRule := 5;   //用dyLineSpacing/20指定行间距

  pf.bLineSpacingRule := 4;   //用dyLineSpacing以缇为单位指定行间距
  pf.dyLineSpacing := RichEdit1.Font.Size * 20 + 20 * 4; //这是笔者大概计算的，可以根据字体大小调节的，行间最小距离，大字体时可能出现上下行重叠，可以设置为300或者自己计算

  RichEdit1.SelectAll;   //只对选择的文本有效，***重要***
  SendMessage(RichEdit1.Handle, EM_SETPARAFORMAT, 0, LPARAM(@pf));
  RichEdit1.SelStart := 0;
  RichEdit1.SelLength := 0;
end;

procedure TForm1.Button3Click(Sender: TObject);

var

pf: PARAFORMAT2;

begin

FillChar(pf, sizeof(paraformat2), #0);

pf.cbSize := SizeOf(paraformat2);

pf.dwMask := PFM_LINESPACING ; //需要设置上 PFM_LINESPACING 标志，bLineSpacingRule和dyLineSpacing才可能有效

// pf.bLineSpacingRule := 0; //单倍行距，dyLineSpacing的值将被忽略

// pf.bLineSpacingRule := 1; //1.5倍行距，dyLineSpacing的值将被忽略

// pf.bLineSpacingRule := 2; //两倍行距，dyLineSpacing的值将被忽略

// pf.bLineSpacingRule := 3; //用dyLineSpacing以缇为单位指定行间距，当此值小于单倍行距时，效果为单倍行距

// pf.bLineSpacingRule := 5; //用dyLineSpacing/20指定行间距

pf.bLineSpacingRule := 4; //用dyLineSpacing以缇为单位指定行间距

pf.dyLineSpacing := RichEdit1.Font.Size * 20 + 20 * 4; //这是笔者大概计算的，可以根据字体大小调节的，行间最小距离，大字体时可能出现上下行重叠，可以设置为300或者自己计算

RichEdit1.SelectAll; //只对选择的文本有效，***重要***

SendMessage(RichEdit1.Handle, EM_SETPARAFORMAT, 0, LPARAM(@pf));

RichEdit1.SelStart := 0;

RichEdit1.SelLength := 0;

end;

2. 为RichEdit设置行号，代码如下：

procedure TForm1.Button4Click(Sender: TObject);
const
  PFNS_PAREN	=	$000;  //e.g. 1)
  PFNS_PARENS	= $100;  //e.g. (1)
  PFNS_PERIOD	= $200;  //e.g. 1.
  PFNS_PLAIN	=	$300;
  PFNS_NONUMBER =	$400;

const
  PFN_NONE     = $00000000;  //无
  PFN_BULLET   = $00000001;  //黑色实心圆点
  PFN_ARABIC   = $00000002;  //0,1,2
  PFN_LCLETTER = $00000003;  //a,b,c
  PFN_UCLETTER = $00000004;  //A,B,C
  PFN_LCROMAN  = $00000005;  //i,ii,iii
  PFN_UCROMAN  = $00000006;  //I,II,III

  var
  pf: PARAFORMAT2;
begin
  FillChar(pf, sizeof(paraformat2), #0);
  pf.cbSize := SizeOf(paraformat2);
  //PFM_NUMBERING: wNumbering 值有效
  //PFM_NUMBERINGSTYLE: wNumberingStyle值有效
  //PFM_NUMBERINGSTART: wNumberingStart值有效
  //PFM_STARTINDENT: dxStartIndent值有效
  pf.dwMask := PFM_NUMBERING or PFM_NUMBERINGSTYLE or PFM_NUMBERINGSTART or PFM_STARTINDENT;//or PFM_OFFSET;

  pf.wNumberingStyle := PFNS_PERIOD;  //设置行号的样式，可以为“)”，“.”，“()”
  pf.wNumberingStart := 1;            //设置行号起始值
  pf.wNumbering := PFN_ARABIC;        //设置行号的格式，可以为阿拉伯数字或者英文字母等格式
  pf.dxStartIndent := 60;             //设置行首缩进值

  RichEdit1.SelectAll;
  SendMessage(RichEdit1.Handle, EM_SETPARAFORMAT, 0, LPARAM(@pf));
  RichEdit1.SelStart := 0;
  RichEdit1.SelLength := 0;
end;

procedure TForm1.Button4Click(Sender: TObject);

const

PFNS_PAREN = $000; //e.g. 1)

PFNS_PARENS = $100; //e.g. (1)

PFNS_PERIOD = $200; //e.g. 1.

PFNS_PLAIN = $300;

PFNS_NONUMBER = $400;

const

PFN_NONE = $00000000; //无

PFN_BULLET = $00000001; //黑色实心圆点

PFN_ARABIC = $00000002; //0,1,2

PFN_LCLETTER = $00000003; //a,b,c

PFN_UCLETTER = $00000004; //A,B,C

PFN_LCROMAN = $00000005; //i,ii,iii

PFN_UCROMAN = $00000006; //I,II,III

var

pf: PARAFORMAT2;

begin

FillChar(pf, sizeof(paraformat2), #0);

pf.cbSize := SizeOf(paraformat2);

//PFM_NUMBERING: wNumbering 值有效

//PFM_NUMBERINGSTYLE: wNumberingStyle值有效

//PFM_NUMBERINGSTART: wNumberingStart值有效

//PFM_STARTINDENT: dxStartIndent值有效

pf.dwMask := PFM_NUMBERING or PFM_NUMBERINGSTYLE or PFM_NUMBERINGSTART or PFM_STARTINDENT;//or PFM_OFFSET;

pf.wNumberingStyle := PFNS_PERIOD; //设置行号的样式，可以为“)”，“.”，“()”

pf.wNumberingStart := 1; //设置行号起始值

pf.wNumbering := PFN_ARABIC; //设置行号的格式，可以为阿拉伯数字或者英文字母等格式

pf.dxStartIndent := 60; //设置行首缩进值

RichEdit1.SelectAll;

SendMessage(RichEdit1.Handle, EM_SETPARAFORMAT, 0, LPARAM(@pf));

RichEdit1.SelStart := 0;

RichEdit1.SelLength := 0;

end;

3. 根据鼠标位置定位光标的方法。

当RichEdit为可用状态时，是不用代码控制此操作的，TRichEdit本身就可以定位光标。但是当RichEdit开始不可用时，则此方法就可能用到了。本例中RichEdit1开始时是不可用的，当在ApplicationEvents1中接收到RichEdit1被双击时则设置RichEdit1的Enable := true;并且定位光标。

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    ApplicationEvents1: TApplicationEvents;
    procedure EnableRichEdit;
    procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  FLastMousePos: TPoint;

implementation

{$R *.dfm}

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var
  mPos: TPoint;
begin
  if msg.message = WM_LBUTTONDBLCLK then begin
    if msg.hwnd = RichEdit1.Parent.Handle then begin
      GetCursorPos(FLastMousePos);
      EnableRichEdit;
    end;
  end ;
end;

procedure TForm1.EnableRichEdit;
var
  cPos: TPoint;
  retCode: integer;
  mR, mC: Word;
begin
  RichEdit1.Enabled := True;
  RichEdit1.SetFocus ;
  RichEdit1.SelStart := 0;

  if (FLastMousePos.X = 0) and (FLastMousePos.Y = 0) then
    GetCursorPos(FLastMousePos);
  FLastMousePos := RichEdit1.ScreenToClient(FLastMousePos);
  retCode := SendMessage(RichEdit1.Handle, EM_CHARFROMPOS, 0, LPARAM(@FLastMousePos));
  mR := HiWord(retCode);
  mC := Loword(retCode);
  cPos.X := mC ;
  cPos.Y := mR ;
  RichEdit1.CaretPos := cPos;

  FLastMousePos.X := 0;
  FLastMousePos.Y := 0;
end;

end.

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ComCtrls, RichEdit, AppEvnts;

type

TForm1 = class(TForm)

RichEdit1: TRichEdit;

ApplicationEvents1: TApplicationEvents;

procedure EnableRichEdit;

procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

FLastMousePos: TPoint;

implementation

{$R *.dfm}

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;

var Handled: Boolean);

var

mPos: TPoint;

begin

if msg.message = WM_LBUTTONDBLCLK then begin

if msg.hwnd = RichEdit1.Parent.Handle then begin

GetCursorPos(FLastMousePos);

EnableRichEdit;

end;

end ;

end;

procedure TForm1.EnableRichEdit;

var

cPos: TPoint;

retCode: integer;

mR, mC: Word;

begin

RichEdit1.Enabled := True;

RichEdit1.SetFocus ;

RichEdit1.SelStart := 0;

if (FLastMousePos.X = 0) and (FLastMousePos.Y = 0) then

GetCursorPos(FLastMousePos);

FLastMousePos := RichEdit1.ScreenToClient(FLastMousePos);

retCode := SendMessage(RichEdit1.Handle, EM_CHARFROMPOS, 0, LPARAM(@FLastMousePos));

mR := HiWord(retCode);

mC := Loword(retCode);

cPos.X := mC ;

cPos.Y := mR ;

RichEdit1.CaretPos := cPos;

FLastMousePos.X := 0;

FLastMousePos.Y := 0;

end;

end.

4. 使Richedit中的链接可以点击

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    procedure WndProc(var Msg: TMessage); override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  mask: Word;
begin
  mask := SendMessage(RichEdit1.Handle, EM_GETEVENTMASK, 0, 0);
  SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
  SendMessage(RichEdit1.Handle, EM_AUTOURLDETECT, Integer(True), 0);
end;

procedure TForm1.WndProc(var Msg: TMessage);
var
  p: TENLink;
  sURL: string;
  CE : TRichEdit;
begin
  if (Msg.Msg = WM_NOTIFY) then
  begin
    if (PNMHDR(Msg.lParam).code = EN_LINK) then
    begin
      p := TENLink(Pointer(TWMNotify(Msg).NMHdr)^);
      if (p.Msg = WM_LBUTTONDOWN) then
      begin
        try
          CE := tRichEdit(Self.ActiveControl);
          SendMessage(CE.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
          sURL := CE.SelText;
          ShellExecute(0, 'open', PChar(sURL), 0, 0, SW_SHOWNORMAL);
        except
        end;
      end;
    end;
  end;
  inherited;
end;

end.

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ComCtrls, RichEdit, ShellAPI;

type

TForm1 = class(TForm)

RichEdit1: TRichEdit;

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

procedure WndProc(var Msg: TMessage); override;

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

var

mask: Word;

begin

mask := SendMessage(RichEdit1.Handle, EM_GETEVENTMASK, 0, 0);

SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);

SendMessage(RichEdit1.Handle, EM_AUTOURLDETECT, Integer(True), 0);

end;

procedure TForm1.WndProc(var Msg: TMessage);

var

p: TENLink;

sURL: string;

CE : TRichEdit;

begin

if (Msg.Msg = WM_NOTIFY) then

begin

if (PNMHDR(Msg.lParam).code = EN_LINK) then

begin

p := TENLink(Pointer(TWMNotify(Msg).NMHdr)^);

if (p.Msg = WM_LBUTTONDOWN) then

begin

try

CE := tRichEdit(Self.ActiveControl);

SendMessage(CE.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));

sURL := CE.SelText;

ShellExecute(0, 'open', PChar(sURL), 0, 0, SW_SHOWNORMAL);

except

end;

inherited;

end;

end.