I'd like to see emojis in color in a TEdit
or TMemo
control using VCL and Delphi 10+.
Can it be done?
Text entered:
π¨πΌβπ€π©πΎβπ©πΌβπ§π»βπ¦πΏ
What I see:
What I'd like to see:
I'd like to see emojis in color in a TEdit
or TMemo
control using VCL and Delphi 10+.
Can it be done?
Text entered:
π¨πΌβπ€π©πΎβπ©πΌβπ§π»βπ¦πΏ
What I see:
What I'd like to see:
Your question made me curious, so tried and here is the result:
Drawing colored fonts in general
Apparently FMX supports this out of the box in later versions, but not in Seattle, which I happen to have. I don't know if the VCL also supports it out of the box in your version, but if not, you can achieve using Direct2D. The trick is to draw text using the D2D1_DRAW_TEXT_OPTIONS_ENABLE_COLOR_FONT
option.
In Seattle (10), this constant is not defined, and - unfortunately - not used in the default TCanvas-compatible functions. But you can call DrawText
or one of the other functions yourself and specify the option.
The general structure is based on this Embarcadero docwiki. The rest is peeked from TDirect2DCanvas, combined with the DrawText documentation.
uses Vcl.Direct2D, Winapi.D2D1;
{$R *.dfm}
procedure TForm1.FormPaint(Sender: TObject);
const
str: string = 'xyzπ¨πΌβπ€π©πΎβπ©πΌβπ§π»βπ¦πΏ';
D2D1_DRAW_TEXT_OPTIONS_ENABLE_COLOR_FONT = 4;
var
c: TDirect2DCanvas;
r: D2D_RECT_F;
begin
c := TDirect2DCanvas.Create(Canvas.Handle, Rect(0, 0, 100, 100));
c.BeginDraw;
try
r.left := 0;
r.top := 0;
r.right := 100;
r.bottom := 50;
// Brush determines the font color.
c.Brush.Color := clBlack;
c.RenderTarget.DrawText(
PWideChar(str), Length(Str), c.Font.Handle, r, c.Brush.Handle,
D2D1_DRAW_TEXT_OPTIONS_ENABLE_COLOR_FONT);
finally
c.EndDraw;
c.Free;
end;
end;
This little piece of code works in a fairly ugly way (in terms of positioning the text), but you can also peek in TDirect2DCanvas, and copy the implementation of one of its text methods to create a function for outputting text in a specific way that you want. And after that it should be fairly easy to apply this to your own TGraphicControl or TCustomControl descendant to create an emoji-supporting label.
Doing that in TEdit
To manage this in TEdit is harder, since drawing the text (and the emoji) is handled by the control itself. It should be possible to create a TEdit descendant and/or hook into its WM_PAINT message and paint over the text using this same trick, but I'm not sure how well that would work.
I gave that a quick shot, but it doesn't really work well perfectly, especially when editing. So I've made this descendant of TEdit. When focused, it draws the text in a normal way, and the colored emoji will be black and white, and split into two characters (the emoji and the color combination character). When the edit loses its focus, the custom paint code takes over, which works well in that scenario. Maybe you can attempt to polish it to make it work while editing as well, but then you have to take scrolling, positioning the caret and other stuff into account. For a TMemo descendant that would be even harder. I hope you're happy with just colored display for now. :-)
type
TMyEdit = class(Vcl.StdCtrls.TEdit)
protected
procedure PaintWindow(DC: HDC); override;
public
constructor Create(AOwner: TComponent); override;
end;
implementation
uses Vcl.Direct2D, Winapi.D2D1;
{$R *.dfm}
const
D2D1_DRAW_TEXT_OPTIONS_ENABLE_COLOR_FONT = 4;
constructor TMyEdit.Create(AOwner: TComponent);
begin
inherited;
DoubleBuffered := True;
end;
procedure TMyEdit.PaintWindow(DC: HDC);
var
c: TDirect2DCanvas;
r: D2D_RECT_F;
begin
// Default drawing when focused. Otherwise do the custom draw.
if Focused then
begin
Inherited;
Exit;
end;
c := TDirect2DCanvas.Create(dc, ClientRect);
c.BeginDraw;
try
r.left := ClientRect.Left;
r.top := ClientRect.Top;
r.right := ClientRect.Right;
r.bottom := ClientRect.Bottom;
// Basic font properties
c.Font.Assign(Font);
// Brush determines the font color.
c.Brush.Color := Font.Color;
c.RenderTarget.DrawText(
PWideChar(Text), Length(Text), c.Font.Handle, r, c.Brush.Handle,
D2D1_DRAW_TEXT_OPTIONS_ENABLE_COLOR_FONT);
finally
c.EndDraw;
c.Free;
end;
end;
© 2022 - 2024 β McMap. All rights reserved.