I\'d like to draw a piece of TEdit.Text using Font.Color different from the default. Are there any examples how to do that?
I\'m attempting to do something like thi
No. A standard tEdit does not have support for custom drawing or having text with multiple colors. As an alternative you can use a tRichEdit with WantReturns=False.
Another small improvement by overriding the CreateParams procedure which fixes the flickering during text selection (mouse move while left button down):
procedure TMyEdit.CreateParams(var Params: TCreateParams);
begin
inherited;
if csDesigning in ComponentState then
exit;
Params.ExStyle := Params.ExStyle or WS_EX_COMPOSITED;
end;
Some improvements to kobik solusion:
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;
Edit
controls do not have owner-draw support, but you can custom-draw it by sub-classing it and handling WM_PAINT
(among many other messages). It's doable, but it would be a world of pain to actually implement 100% correctly. From the docs: Developing Custom Draw Controls in Visual C++:
Note that owner-draw will work for most controls. However, it doesn't work for edit controls; and with regards to the list control, it works only for report-view style
I was also interested to find out how deep the rabbit hole goes, so,
Here is a code sample using an interposer class (still needs to implement selection but the custom drawing works when the caret is in the control):
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;