用代码实现RichEdit超连接

Question

to dong163(瑞雪):谢谢你第一个捧场

Answer 1

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls;type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    procedure RichEdit1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}uses
  RichEdit;const
  cReservedWordCount = 65; //保留字数量
  cReservedWords: array[0..Pred(cReservedWordCount)] of string = //保留字列表
(
'and', 'array', 'as', 'asm',
'begin', 'case', 'class', 'const',
'constructor', 'destructor', 'dispinterface', 'div',
'do', 'downto', 'else', 'end',
'except', 'exports', 'file', 'finalization',
'finally', 'for', 'function', 'goto',
'if', 'implementation', 'in', 'inherited',
'initialization', 'inline', 'interface', 'is',
'label', 'library', 'mod', 'nil',
'not', 'object', 'of', 'or',
'out', 'packed', 'procedure', 'program',
'property', 'raise', 'record', 'repeat',
'resourcestring', 'set', 'shl', 'shr',
'string', 'then', 'threadvar', 'to',
'try', 'type', 'unit', 'until',
'uses', 'var', 'while', 'with',
'xor'
);  cDirectiveCount = 39; //指示字数量
  cDirectives: array [0..Pred(cDirectiveCount)] of string = //指示字列表
(
'absolute', 'abstract', 'assembler', 'automated',
'cdecl', 'contains', 'default', 'dispid',
'dynamic', 'export', 'external', 'far',
'forward', 'implements', 'index', 'message',
'name', 'near', 'nodefault', 'overload',
'override', 'package', 'pascal', 'private',
'protected', 'public', 'published', 'read',
'readonly', 'register', 'reintroduce', 'requires',
'resident', 'safecall', 'stdcall', 'stored',
'virtual', 'write', 'writeonly'
);function ReservedWordIndex(mStr: string): Integer; { 返回保留字的相对序号 }
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to Pred(cReservedWordCount) do
    if SameText(cReservedWords[I], mStr) then begin
      Result := I;
      Break;
    end;
end; { ReservedWordIndex }function DirectiveIndex(mStr: string): Integer; { 返回指示字的相对序号 }
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to Pred(cDirectiveCount) do
    if SameText(cDirectives[I], mStr) then begin
      Result := I;
      Break;
    end;
end; { DirectiveIndex }procedure TForm1.RichEdit1Change(Sender: TObject);
var
  S: string;
  T: string;
  I, J, L: Integer;
  vSelStart: Integer;
  vSelLength: Integer;
  E: Extended;
begin
  S := TRichEdit(Sender).Text;
  if S = '' then Exit;
  L := Length(S);
  J := 1;
  TRichEdit(Sender).Perform(EM_HIDESELECTION, Longint(True), 0);
  vSelStart := TRichEdit(Sender).SelStart;
  vSelLength := TRichEdit(Sender).SelLength;
  TRichEdit(Sender).SelStart := J - 1;
  TRichEdit(Sender).SelLength := L - (J - 1);
  TRichEdit(Sender).SelAttributes.Color := clWindowText;
  TRichEdit(Sender).SelAttributes.Style := [];
  while J <= L do begin
    T := '';
    for I := J to L do
      if S[I] in ['a'..'z', '0'..'9', 'A'..'Z', '_'] then
        T := T + S[I]
      else Break;
    if T <> '' then begin
      TRichEdit(Sender).SelStart := J - 1;
      TRichEdit(Sender).SelLength := Length(T);
      if (ReservedWordIndex(T) >= 0) or (DirectiveIndex(T) >= 0) then begin //保留字
        TRichEdit(Sender).SelAttributes.Color := clWindowText;
        TRichEdit(Sender).SelAttributes.Style := [fsBold];
      end else if TryStrToFloat(T, E) then begin //数字
        TRichEdit(Sender).SelAttributes.Color := clRed;
        TRichEdit(Sender).SelAttributes.Style := [fsBold];
      end;
      Inc(J, Length(T));
    end else begin
      if S[J] = '''' then begin
        T := '''';
        for I := J + 1 to L do
          if S[I] in ['''', #13, #10] then begin
            if S[I] = '''' then T := T + '''';
            Break;
          end else T := T + S[I];
        if T <> '' then begin //字符
          TRichEdit(Sender).SelStart := J - 1;
          TRichEdit(Sender).SelLength := Length(T);
          TRichEdit(Sender).SelAttributes.Color := clNavy;
          TRichEdit(Sender).SelAttributes.Style := [fsBold, fsItalic];
          Inc(J, Length(T));
        end;
      end else if S[J] = '#' then begin
        T := '#';
        for I := J + 1 to L do
          if S[I] in ['$', '0'..'9', 'A'..'F', 'a'..'f'] then
            T := T + S[I]
          else Break;
        if T <> '' then begin //字符
          TRichEdit(Sender).SelStart := J - 1;
          TRichEdit(Sender).SelLength := Length(T);
          TRichEdit(Sender).SelAttributes.Color := clNavy;
          TRichEdit(Sender).SelAttributes.Style := [fsBold, fsItalic];
          Inc(J, Length(T));
        end;
      end else if Copy(S, J, 2) = '//' then begin
        T := '//';
        for I := J + 2 to L do
          if S[I] in [#13, #10] then
            Break
          else T := T + S[I];
        if T <> '' then begin //注释
          TRichEdit(Sender).SelStart := J - 1;
          TRichEdit(Sender).SelLength := Length(T);
          TRichEdit(Sender).SelAttributes.Color := clNavy;
          TRichEdit(Sender).SelAttributes.Style := [fsItalic];
          Inc(J, Length(T));
        end;
      end else if S[J] = '{' then begin
        T := '{';
        for I := J + 1 to L do
          if S[I] = '}' then begin
            T := T + '}';
            Break
          end else T := T + S[I];
        if T <> '' then begin //注释
          TRichEdit(Sender).SelStart := J - 1;
          TRichEdit(Sender).SelLength := Length(T);
          TRichEdit(Sender).SelAttributes.Color := clNavy;
          TRichEdit(Sender).SelAttributes.Style := [fsItalic];
          Inc(J, Length(T));
        end;
      end else if Copy(S, J, 2) = '(*' then begin
        T := '(*';
        for I := J + 2 to L do
          if Copy(S, I, 2) = '*)' then begin
            T := T + '*)';
            Break;
          end else T := T + S[I];
        if T <> '' then begin //注释
          TRichEdit(Sender).SelStart := J - 1;
          TRichEdit(Sender).SelLength := Length(T);
          TRichEdit(Sender).SelAttributes.Color := clNavy;
          TRichEdit(Sender).SelAttributes.Style := [fsItalic];
          Inc(J, Length(T));
        end;
      end;
    end;
    if T = '' then Inc(J);
  end;
  TRichEdit(Sender).SelStart := vSelStart;
  TRichEdit(Sender).SelLength := vSelLength;
  TRichEdit(Sender).Perform(EM_HIDESELECTION, Longint(False), 0);
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  RichEdit1.Font.Name := 'Courier New';
  RichEdit1.Font.Size := 10;
  RichEdit1.Lines.Text :=
'(* 没有语法分析并且处理速度太慢 *)'#13#10 + 
'function ReservedWordIndex(mStr: string): Integer; { 返回保留字的相对序号 }'#13#10 +
'var'#13#10 +
'  I: Integer;'#13#10 +
'begin'#13#10 +
'  Result := -1;'#13#10 +
'  for I := 0 to Pred(cReservedWordCount) do'#13#10 +
'    if SameText(cReservedWords[I], mStr) then begin'#13#10 +
'      Result := I;'#13#10 +
'      Break;'#13#10 +
'    end;'#13#10 +
'end; { ReservedWordIndex }'#13#10;
end;end.