Anzeige farbiger Emoji (unicode Zeichen) mit Segoe UI Emoji Schrift in Delphi

[MaBuSE]

Zitat von KodeZwerg:

Wegen Windows 7 sehe ich leider keine emoji, was passiert denn bei "Font.Color := WasAnderes;" ?

Mit Font.Color := clRed; kannst Du fest legen, das die ganze Schrift in Rot dargestellt wird.
Die Emoji sind aber ein Zeichen, das mit mehreren verschiedenen Farben gezeichnet wird.

Und die Schrift "Segoe UI Emoji" wird ab Win8.1 mitgeliefert.
Bzw. die Emoji Unterstützung.
Wenn ich es richtig verstanden habe, wird automatisch das Emoji aus der Segoe UI Emoj Schrift angezeigt, wenn die ausgewählte Schrift keine eigenen Emoji hat.

[EWeiss]

sorry will das mal testen wo kann man den laden ?
Den farbigen Font!

gruss

[MaBuSE]

Zitat von EWeiss:

sorry will das mal testen wo kann man den laden ?
Den farbigen Font!

gruss

Der ist ab Windows 8.1 Bestandteil von Windows

Auf die Frage, wie gebe ich denn die Zeichen unter Windows 10 ein:

Rechtsklick auf die Taskbar, dann "Bildschirmtastatur anzeigen (Schaltfläche)" klicken und dann erscheint neben der Uhr eine kleine Tastatur (Icon)
Klick darauf und es geht die Bildschirmtastatur auf.
Links neben der Leertaste ist ein Smiley. -> Draufklicken

Oder einfach per Copy & Paste. Ist ja normaler Text

[EWeiss]

Zitat:

Der ist ab Windows 8.1 Bestandteil von Windows

Nun ich habe windows7

gruss

[MaBuSE]

Zitat von EWeiss:

Zitat:

Der ist ab Windows 8.1 Bestandteil von Windows

Nun ich habe windows7

gruss

Update auf Windows 10 ?

Hier ist noch was interesanntes zum Thema von MS.
https://msdn.microsoft.com/en-us/lib...(v=vs.85).aspx

Aber ich hatte ja die Hoffnung, das das Delphi schon kann und man es nur einschalten muss.

[EWeiss]

Zitat:

Update auf Windows 10 ?

Vergiss es.. ok muss nicht sein mein Test.
Bin raus.

gruss

[Uwe Raabe]

Zitat von MaBuSE:

Aber ich hatte ja die Hoffnung, das das Delphi schon kann und man es nur einschalten muss.

So ganz aus dem Stand noch nicht, aber wenn man die TDirect2DCanvas ableitet und TextOut geringfügig modifiziert:

[Uwe Raabe]

Hier noch der Quelltext der Form-Unit:

Delphi-Quellcode:

unit Unit299;

interface

uses
  Vcl.Forms;

type
  TForm299 = class(TForm)
    procedure FormPaint(Sender: TObject);
  public
  end;

var
  Form299: TForm299;

implementation

uses
  Winapi.D2D1,
  System.Win.ComObj,
  Vcl.Graphics, Vcl.Direct2D;

{$R *.dfm}

type
  TMyCanvas = class(TDirect2DCanvas)
  public
    procedure TextOut(X, Y: Integer; const Text: string); override;
  end;

procedure TMyCanvas.TextOut(X, Y: Integer; const Text: string);
var
  TextRange: TDwriteTextRange;
  TextLayout: IDWriteTextLayout;
  TextMetrics: TDWriteTextMetrics;
begin
  OleCheck(DWriteFactory.CreateTextLayout(PWideChar(Text), Length(Text),
    Font.Handle, 0, 0, TextLayout));
  TextRange.startPosition := 0;
  TextRange.length := Length(Text);
  if fsUnderline in Font.Style then
    TextLayout.SetUnderline(True, TextRange);

  if fsStrikeOut in Font.Style then
    TextLayout.SetStrikethrough(True, TextRange);

  TextLayout.SetWordWrapping(DWRITE_WORD_WRAPPING_NO_WRAP);

  RequiredState([csHandleValid,  csFontValid, csBrushValid]);
  if Brush.Style <> bsClear then
  begin
    TextLayout.GetMetrics(TextMetrics);
    RenderTarget.FillRectangle(D2D1RectF(X, Y,
      X+TextMetrics.widthIncludingTrailingWhitespace,
      Y+TextMetrics.height), Brush.Handle);
  end;

  RenderTarget.DrawTextLayout(D2D1PointF(x-0.5, y-0.5), TextLayout,
    Font.Brush.Handle, 4);
end;

procedure TForm299.FormPaint(Sender: TObject);
var
  FD2DCanvas: TDirect2DCanvas;
begin
  FD2DCanvas := TMyCanvas.Create(Canvas.Handle, ClientRect);
  try
    FD2DCanvas.BeginDraw;
    FD2DCanvas.TextOut(10, 10, '😍😀😊😜☹😐😅😎❤😘😂😃💋💖😋😭😇🙄💩🙈🙉🙊🔞');
    FD2DCanvas.EndDraw;
  finally
    FD2DCanvas.Free;
  end;
end;

end.

[MaBuSE]

Zitat von Uwe Raabe:

Zitat von MaBuSE:

Aber ich hatte ja die Hoffnung, das das Delphi schon kann und man es nur einschalten muss.

So ganz aus dem Stand noch nicht, aber wenn man die TDirect2DCanvas ableitet und TextOut geringfügig modifiziert:

WOW,
danke für das Beispiel. Funktioniert gut. 👍🏻👍🏻👍🏻 🤘🏻

Der einzige Unterschied zwischen deiner TextOut und der von Embarcadero is ja nur der Parameter:

Code:

D2D1_DRAW_TEXT_OPTIONS_ENABLE_COLOR_FONT              = 0x00000004

Aus

Delphi-Quellcode:

RenderTarget.DrawTextLayout(D2D1PointF(x-0.5, y-0.5), TextLayout,
    FFont.FBrush.Handle, D2D1_DRAW_TEXT_OPTIONS_NONE);

wird

Delphi-Quellcode:

  RenderTarget.DrawTextLayout(D2D1PointF(x-0.5, y-0.5), TextLayout,
    Font.Brush.Handle, 4);

Geht das nur mit Direct2D oder könnte man das auch generell in der VLC für alle Controls anschalten. (z.B. via ClassHelper oder ähnliches)

Viele Grüße
MaBuSE

[Der schöne Günther]

Zitat von MaBuSE:

Auf die Frage, wie gebe ich denn die Zeichen unter Windows 10 ein:

Seit Version 1803 kann man genauso gut [Win]+[Punkt] drücken


https://imgur.com/a/S4JfjFa


Unbenannt.jpg