var
Graphics: LONG_PTR;
Fam: GpFontFamily;
TempFont: GpFont;
rb: TRect;
xWidth, YHeight: Integer;
strFormat: GPSTRINGFORMAT;
boundingBox, layoutRect: TGPRectF;
begin
result := GenericError;
strFormat :=
nil;
Fam :=
nil;
TempFont :=
nil; ..
// hier kommt Warnung unter D2010 in Delphi 10.2.3 nicht. Deshalb war es vorher nicht addiert.
// habe es aber jetzt trotzdem addiert und ignoriere die Warnung.
Graphics := 0;
try
GdipCheck(GdipCreateFontFamilyFromName(PWideChar(UseFont), FontCollection, Fam));
if Assigned(Fam)
then
begin
GdipCheck(GdipCreateFont(Fam, UseSize, FontStyle, 2, TempFont));
if Assigned(TempFont)
then
begin
// 0: Kein Schatten
// Positiver wert für Schatten Rechts
// Negativer wert für Schatten links
// Zeichne den string
GdipCheck(GdipCreateStringFormat(0, 0, strFormat));
GdipCheck(GdipCreateFromHDC(
DC, Graphics));
FillChar(boundingBox, SizeOf(boundingBox), 0);
FillChar(layoutRect, SizeOf(layoutRect), 0);
GdipCheck(GdipMeasureString(Graphics, PWideChar(UseText), length(UseText), TempFont,
@layoutRect, strFormat, @boundingBox,
nil,
nil));
if Assigned(strFormat)
then
GdipCheck(GdipDeleteStringFormat(strFormat));
if not WordWrap
then
begin
xWidth := round(boundingBox.Width + 0.5);
YHeight := round(boundingBox.Height + 1.5);
if BlurText
then
begin
SetRect(rb, rec.Left, rec.Top, rec.Left + xWidth, rec.Top + YHeight);
BlurTextPlus(
DC, UseText, rb, TempFont, BlurColor, 4, UseStrFormat);
end;
end else
begin
xWidth := rec.Right;
YHeight := rec.Bottom;
if BlurText
then
begin
SetRect(rb, rec.Left, rec.Top, rec.Left + xWidth, rec.Top + YHeight);
BlurTextPlus(
DC, UseText, rb, TempFont, BlurColor, 4, UseStrFormat);
end;
end;
result := DrawStringFormatedEx(Graphics, UseText, rec.Left, rec.Top, xWidth, YHeight,
ColrARGB, SkinEngine.SK_TEXTRENDERING, TempFont, ShadowOffset, UseStrFormat);
end;
end;
finally
if Graphics <> 0
then
begin
GdipCheck(GdipDeleteGraphics(Graphics));
Graphics := 0;
end;
if Assigned(TempFont)
then
begin
GdipCheck(GdipDeleteFont(TempFont));
// Und hier kracht es unter Win10 wenn TempFont mit irgendwas gefüllt wird. (In D2010 nicht! )
TempFont :=
nil;
end;
if Assigned(Fam)
then
begin
GdipCheck(GdipDeleteFontFamily(Fam));
Fam :=
nil;
end;
end;
end;