ＲｉｃｈＥｄｉｔに改行コードを見える文字で表示するには？ (ID:24399)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

http://www.geocities.jp/norg1964/delphianworld/data/le/ememo200.lzh
ここの、ExtMemoを参考に、昔作った事があります。

unit RichEditDrawCRLF;

interface

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

type
  TRichEditDrawCRLF = class(TRichEdit)
  private
    FCanvas: TCanvas;
    procedure CNNotify(var Msg: TWMNotify); message CN_NOTIFY;
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure WMChar(var Msg: TWMChar); message WM_CHAR;
    procedure DrawCRLFMark(Start, Stop: integer; fErase: boolean);
    function GetEditRect: TRect;
    function GetFirstVisibleLine: integer;
    function GetTextLength: integer;
  protected
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
  public  { Public 宣言 }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function CharFromPos(X, Y: integer): integer;
    function LineIndex(line: integer): integer;
  published
    { Published 宣言 }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TRichEditDrawCRLF]);
end;

{ TRichEditDrawCRLF }

procedure TRichEditDrawCRLF.CNNotify(var Msg: TWMNotify);
var
  r: TRect;
begin
  inherited;
  r := GetEditRect;
  DrawCRLFMark(LineIndex(GetFirstVisibleLine), CharFromPos(r.Right, r.Bottom), false);
end;

procedure TRichEditDrawCRLF.WMPaint(var Msg: TWMPaint);
var
  r: TRect;
begin
  inherited;
  r := GetEditRect;
  DrawCRLFMark(LineIndex(GetFirstVisibleLine), CharFromPos(r.Right, r.Bottom), false);
end;

procedure TRichEditDrawCRLF.WMChar(var Msg: TWMChar);
var
  i, e, l: integer;
  c: PChar;
label
  Normal, CrLf;
begin
  if Msg.CharCode = VK_BACK then goto Normal;
  l := GetTextLength;
  i := SelStart;
  if i = l then goto CrLf;
  c := @Text[i + 1];
  if (c^ = ^M) or (c^ = ^J) then goto CrLf;
  e := i;
  while true do begin
    if (c^ > ' ') and (c^ <> #$81) then goto Normal;
    if c^ = #$81 then begin
      Inc(c);
      Inc(e);
      if c^ <> #$40 then goto Normal;
    end;
    inc(c);
    inc(e);
    if (e = l) or (c^ = ^M) or (c^ = ^J) then break;
  end;
//キャレット位置から改行までスペースが連続している場合
  DrawCRLFMark(i, e, true);
  inherited;
  DrawCRLFMark(i, e + 1, false);
  Exit;
CrLf: //キャレット位置が改行またはテキスト末の場合
  DrawCRLFMark(i, i, true);
  inherited;
  DrawCRLFMark(i, SelStart, false);
  Exit;
Normal: // 上記以外の場合
  inherited;
end;

procedure TRichEditDrawCRLF.CreateWnd;
begin
  inherited CreateWnd;
  FCanvas.Handle := GetDC(Handle);
end;

procedure TRichEditDrawCRLF.DrawCRLFMark(Start, Stop: integer; fErase: boolean);
var
  i,e, l: Integer;
  c: PChar;
  p: TPoint;
  er, cr: TRect;
  SelS, SelE: Integer;
  SF: Boolean;
begin
  FCanvas.Font.Assign(Font);
  FCanvas.Font.Height := FCanvas.TextWidth('□') - 2;
  er := GetEditRect;
  i := Start;
  e := Stop;
  l := GetTextLength; //テキストのLength
  SelS := SelStart;
  SelE := SelS + SelLength;
  SF := SelLength > 0;

if e >= l then//ファイルの終わりなら
  begin
    FCanvas.Font.Name := 'Symbol';
    Perform(EM_POSFROMCHAR, WPARAM(@p), e);
    if p.x < er.Right then
    begin
//      HideCaret(Handle);
      if fErase then
      begin
        FCanvas.Brush.Color := Color;
        FCanvas.Font.Color := Color;
      end else
        FCanvas.Font.Color := clBlue;
      FCanvas.TextOut(p.x + 1, p.y + 1, 'ャ');
//      ShowCaret(Handle);
    end;
    e := l - 1;
  end;
  if e < 0 then Exit;

c := @Text[i + 1]; // Text[i + 1] 形式で文字判別をすると非常に遅いため

// 本文内編集記号の描画(選択範囲内の編集記号は描画しない)

HideCaret(Handle);
  while i <= e do begin
    if SF and (i >= SelS) then begin
      i := SelE;
      c := @Text[SelE + 1];
      SF := false;
      continue;
    end;
    case c^ of
      ^M:
      begin
        FCanvas.Font.Name := 'Symbol';
        Perform(EM_POSFROMCHAR, WPARAM(@p), i);
        if fErase then
        begin
          FCanvas.Brush.Color := Color;
          FCanvas.Font.Color := Color;
        end else
          FCanvas.Font.Color := clRed;
        FCanvas.TextOut(p.x + 1, p.y + 2, 'ッ');
        if PChar(c + 1)^ = #$0A then begin Inc(c); Inc(i); end;
      end;
      ^J:
      begin
        FCanvas.Font.Name := 'Symbol';
        Perform(EM_POSFROMCHAR, WPARAM(@p), i);
        if fErase then
        begin
          FCanvas.Brush.Color := Color;
          FCanvas.Font.Color := Color;
        end else
          FCanvas.Font.Color := clGreen;
        FCanvas.TextOut(p.x + 1, p.y + 2, 'ッ');
        if PChar(c + 1)^ = #$0A then begin Inc(c); Inc(i); end;
      end;
    end;  //case
    Inc(c);
    Inc(i);
  end;  //while
  ShowCaret(Handle);
  cr := ClientRect;
  FCanvas.Brush.Color := Color;
  if er.Left > cr.Left then FCanvas.FillRect(Rect(cr.Left, cr.Top, er.Left, cr.Bottom));
  if er.Top > cr.Top then FCanvas.FillRect(Rect(cr.Left, cr.Top, cr.Right, er.Top));
  if cr.Bottom > er.Bottom then FCanvas.FillRect(Rect(cr.Left, er.Bottom, cr.Right, cr.Bottom));
  if cr.Right > er.Right then FCanvas.FillRect(Rect(er.Right, cr.Top, cr.Right, cr.Bottom));
end;

function TRichEditDrawCRLF.CharFromPos(X, Y: integer): integer;
var
  Pos: TPoint;
begin
  Pos.X := X;
  Pos.Y := Y;
  Result := Perform(EM_CHARFROMPOS, 0, LPARAM(@Pos));
end;

function TRichEditDrawCRLF.GetEditRect: TRect;
begin
  Perform(EM_GETRECT, 0, LPARAM(@Result));
end;

function TRichEditDrawCRLF.LineIndex(line: integer): integer;
begin
  Result := Perform(EM_LINEINDEX, line, 0);
end;

function TRichEditDrawCRLF.GetFirstVisibleLine: integer;
begin
  Result := Perform(EM_GETFIRSTVISIBLELINE, 0, 0);
end;

constructor TRichEditDrawCRLF.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TCanvas.Create;
end;

destructor TRichEditDrawCRLF.Destroy;
begin
  FCanvas.Free;
  inherited Destroy;
end;

procedure TRichEditDrawCRLF.DestroyWnd;
begin
  ReleaseDC(Handle, FCanvas.Handle);
  inherited DestroyWnd;
end;

function TRichEditDrawCRLF.GetTextLength: integer;
begin
  Result := Perform(WM_GETTEXTLENGTH, 0, 0);
end;

end.

←解決時は質問者本人がここをチェックしてください。

戻る