通过网盘分享的文件：lineNumberV3.rar
链接: https://pan.baidu.com/s/1TqgDDv6VDIeQGgNYhMzohg 提取码: ws4u

当前行号红色显示，5进制显示

 01]拖一个PaintBox和Memo到界面上，PaintBox1与Memo1的字体相同，字体大小相同,PaintBox1的Top要比Memo1大2(要么用一个Panel高度为2)，

 

且Memo1的Ctl3D设为False;

WordWrap设为Falce;

 

 02]重写，行高  LineHeight := Canvas.TextHeight('Wg')+memo1.Font.Size div 2 -1;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    PaintBox1: TPaintBox;
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Memo1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
 FOriginalMemoProc: TWndMethod;
    procedure MemoWndProc(var Message: TMessage);

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  // 保存原始窗口过程
  FOriginalMemoProc := Memo1.WindowProc;
  // 替换为自定义窗口过程
  Memo1.WindowProc := MemoWndProc;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 // 恢复原始窗口过程
  Memo1.WindowProc := FOriginalMemoProc;
end;

// 键盘 有上，下 键， 翻页键里  ，更新 行号
procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  PaintBox1.Invalidate;
end;

procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
PaintBox1.Invalidate;
end;

procedure TForm1.MemoWndProc(var Message: TMessage);
begin
  // 处理滚动消息
  if Message.Msg = WM_VSCROLL then
  begin
    case TWMVScroll(Message).ScrollCode of
      SB_LINEUP         :begin PaintBox1.Invalidate;  end;  // Caption := '向上滚动一行';
      SB_LINEDOWN:       begin PaintBox1.Invalidate;  end;  // Caption := '向下滚动一行';
      SB_PAGEUP:         begin PaintBox1.Invalidate;  end; // Caption := '向上滚动一页';
      SB_PAGEDOWN:       begin PaintBox1.Invalidate;  end;  //Caption := '向下滚动一页';
      SB_THUMBPOSITION : begin PaintBox1.Invalidate;  end;       //鼠标 按住 滚动条 向 上
      SB_THUMBTRACK :    begin PaintBox1.Invalidate;  end;      //鼠标 按住 滚动条 向 下

    end;
  end;
   //  鼠标 滚轮 上下移动时，显示行号
  if Message.Msg = WM_MOUSEWHEEL then    begin
        PaintBox1.Invalidate;
  end;

  // 调用原始窗口过程
  FOriginalMemoProc(Message);
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  i, LineHeight, VisibleLines: Integer;
  FirstVisible, LastVisible: Integer;
  currLine:integer;//当前行
  R: TRect;
begin
  with PaintBox1.Canvas do
  begin
    Brush.Color := clBtnFace;
    FillRect(PaintBox1.ClientRect);

    // 计算可见行范围
    LineHeight := Canvas.TextHeight('Wg')+memo1.Font.Size div 2 -1; //这里进行微 调
    FirstVisible := SendMessage(Memo1.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
    VisibleLines := Memo1.Height div LineHeight;
    LastVisible := FirstVisible + VisibleLines;

    currLine:=  SendMessage(memo1.Handle, EM_LINEFROMCHAR, memo1.SelStart, 0);

    // 绘制行号
    for i := FirstVisible to LastVisible do      begin
      R := Rect(0, (i - FirstVisible) * LineHeight, PaintBox1.Width, (i - FirstVisible + 1) * LineHeight);

      if i=currLine then  begin   //当前行 红色 行号
                               Font.Color := clRed ;
                               TextRect(R, R.Right - TextWidth(IntToStr(i + 1)) - 2, R.Top, IntToStr(i + 1))
                          end
               else  begin
                       Font.Color := clblack;
                        if i mod 5=4 then   TextRect(R, R.Right - TextWidth(IntToStr(i + 1)) - 2, R.Top, IntToStr(i + 1))
                        else   TextRect(R, R.Right - TextWidth(IntToStr(i + 1)) - 2, R.Top, '-') ;
                      end;
    end;
  end;
end;

end.