如何自定义绘制TEdit控件的文本？

Question

我希望能够使用不同于默认值的字体颜色来绘制TEdit.Text。是否有任何示例可以展示如何实现？

我试图做类似于这样的事情：

注：这张截图仅仅是一个草图，但它使我相信问题是可以解决的。

- OnTheFly

---

欢迎分享您的“解决方案”，这样我们可以讨论并提供反馈（截图不是解决方案）。 - kobik

@kobik，可能会有一系列简单的问题专门针对我遇到的特定问题。但这可能会在以后发生，目前我没有卡住。 - OnTheFly

Answer 1

Edit控件不支持自定义绘制，但是你可以通过子类化并处理WM_PAINT消息来实现它。这是可行的，但是要完全正确地实现它将会很麻烦。根据文档：在Visual C++中开发自定义绘制控件：

请注意，对于大多数控件，所有者绘制都适用。然而，对于编辑控件，它不起作用；而对于列表控件，仅适用于报表视图样式。

我也很想知道兔子洞有多深，因此，以下是使用interposer类的示例代码（尚需实现选择，但当插入符在控件中时，自定义绘制会起作用）：

type
  TEdit = class(StdCtrls.TEdit)
  private
    FCanvas: TCanvas;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  protected
    procedure WndProc(var Message: TMessage); override;
    procedure Paint; virtual;
    procedure PaintWindow(DC: HDC); override;
    property Canvas: TCanvas read FCanvas;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

...

constructor TEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
end;

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

procedure TEdit.Paint;
var
  R: TRect;
  I: Integer;
  S: String;
begin
  R := ClientRect;
  Inc(R.Left, 1);
  Inc(R.Top, 1);
  Canvas.Brush.Assign(Self.Brush);
  Canvas.Font.Assign(Self.Font);
  for I := 1 to Length(Text) do
  begin
    if Text[I] in ['0'..'9'] then
      Canvas.Font.Color := clRed
    else
      Canvas.Font.Color := clGreen;
    S := Text[I];
    DrawText(Canvas.Handle, PChar(S), -1, R, DT_LEFT or DT_NOPREFIX or
      DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
    Inc(R.Left,Canvas.TextWidth(S));
  end;
end;

procedure TEdit.PaintWindow(DC: HDC);
begin
  FCanvas.Lock;
  try
    FCanvas.Handle := DC;
    try
      TControlCanvas(FCanvas).UpdateTextFlags;
      Paint;
    finally
      FCanvas.Handle := 0;
    end;
  finally
    FCanvas.Unlock;
  end;
end;

procedure TEdit.WMPaint(var Message: TWMPaint);
begin
  ControlState := ControlState+[csCustomPaint];
  inherited;
  ControlState := ControlState-[csCustomPaint];
end;

procedure TEdit.WndProc(var Message: TMessage);
begin
  inherited WndProc(Message);
  with Message do
    case Msg of
      CM_MOUSEENTER, CM_MOUSELEAVE, WM_LBUTTONUP, WM_LBUTTONDOWN,
      WM_KEYDOWN, WM_KEYUP,
      WM_SETFOCUS, WM_KILLFOCUS,
      CM_FONTCHANGED, CM_TEXTCHANGED:
      begin
        Invalidate;
      end;
   end; 
end;

- kobik

---

谢谢，这个例子真的推动了我的学习，并指出了我完全忽略的许多细节（例如，csCustomPaint）。 - OnTheFly

由于你没有使用控件自身的表面，因此必须考虑所有可能的显示情况。例如，除了选择之外，还必须考虑当文本应该以第一个字符以外的字符开头显示时的情况 - 当文本较大以适应控件并且用户已经将其滚动到末尾时。实际上，你将要开发自己的编辑控件，而不是使用现有的控件！ - Sertac Akyuz

@SertacAkyuz 我刚刚使用了kobik提供的代码，只是更改了文本绘制方式，并且你提到的所有情况都得到了正确处理。尽管这是5年后在不同的操作系统和Delphi版本上进行的，但作为一个参考，上述代码对我所要做的工作非常有效。 - Eric Fortier

Answer 2

标准的tEdit不支持自定义绘制或者使用多个颜色展示文本。作为替代方案，您可以使用WantReturns=False的tRichEdit。

- Mike W

---

我同意添加自定义绘图支持是一件真正的痛苦，因为它直接从TWinControl继承而来，但是我已经证明它是相当可行的。 - OnTheFly

如果光标在控件内部，如果您的自定义绘图能够正常工作，我会感到惊讶。它可以吗？ - Sertac Akyuz

@SertacAkyuz，说我的尝试“有效”是一个非常大胆的陈述 :-) 然而，我并不相信这完全不可行。 - OnTheFly

@Mike W，编辑控件不支持所有者绘制，但您可以通过子类化控件并处理WM_PAINT（以及许多其他消息）来进行自定义绘制。这是可行的，但需要花费大量精力。 - kobik

@kobik - 同意。我应该说“没有内置支持”。 - Mike W

Answer 3

一些针对kobik解决方案的改进：

procedure TMyEdit.Paint;
var
  R: TRect;
  I: Integer;

  NewColor : TColor;
  NewBackColor : TColor;

  procedure DrawEx(S: String);
  begin
     if ((i-1)>=Self.SelStart) and ((i-1)<=(Self.SelStart+(Self.SelLength-1)))
        and (Self.SelLength>0) and (Self.focused)
       then begin
         Canvas.Font.Color  := clWhite;
         Canvas.Brush.Color := NewColor;
       end else begin
         Canvas.Font.Color  := NewColor;
         Canvas.Brush.Color := NewBackColor;
       end;
     Canvas.Brush.Style := bsSolid;
     DrawText(Canvas.Handle, PChar(S), -1, R, DT_LEFT or DT_NOPREFIX or
       DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
  end;

begin
  R := ClientRect;
  Inc(R.Left, 1);
  Inc(R.Top, 1);
  Canvas.Brush.Assign(Self.Brush);
  Canvas.Font.Assign(Self.Font);

  if Self.Focused then begin
      NewBackColor       := clYellow;
      Canvas.Brush.Color := NewBackColor;
      Canvas.Brush.Style := bsSolid;
      Canvas.FillRect(ClientRect);
      Canvas.DrawFocusRect(ClientRect);
    end else NewBackColor := clWhite;

  for I:=1 to Length(Text) do begin
   if PasswordChar=#0 then begin
     if Text[I] in ['0'..'9'] then begin
       NewColor := clRed;
       DrawEx(Text[I]);
      end else begin
       NewColor := clGreen;
       DrawEx(Text[I]);
      end;
     Inc(R.Left,Canvas.TextWidth(Text[I]));
    end else begin //with passwordchar
       NewColor := clBlack;
       DrawEx(PasswordChar);
     Inc(R.Left,Canvas.TextWidth(PasswordChar));
    end;
  end;
end;

- user2034020

Answer 4

通过重写CreateParams过程来进行另一个小的改进，解决了在文本选择期间（鼠标移动时左键按下）出现的闪烁问题：

procedure TMyEdit.CreateParams(var Params: TCreateParams);
begin
    inherited;
    if csDesigning in ComponentState then
        exit;
    Params.ExStyle := Params.ExStyle or WS_EX_COMPOSITED;
end;

- jampeter