source: trunk/Packages/Graphics32/GR32_Text_VCL_D2D.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 22.7 KB
Line 
1unit GR32_Text_VCL_D2D;
2
3(* ***** BEGIN LICENSE BLOCK *****
4 * Version: MPL 1.1 or LGPL 2.1 with linking exception
5 *
6 * The contents of this file are subject to the Mozilla Public License Version
7 * 1.1 (the "License"); you may not use this file except in compliance with
8 * the License. You may obtain a copy of the License at
9 * http://www.mozilla.org/MPL/
10 *
11 * Software distributed under the License is distributed on an "AS IS" basis,
12 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
13 * for the specific language governing rights and limitations under the
14 * License.
15 *
16 * Alternatively, the contents of this file may be used under the terms of the
17 * Free Pascal modified version of the GNU Lesser General Public License
18 * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions
19 * of this license are applicable instead of those above.
20 * Please see the file LICENSE.txt for additional information concerning this
21 * license.
22 *
23 * The Original Code is Vectorial Polygon Rasterizer for Graphics32
24 *
25 * The Initial Developer of the Original Code is
26 * Christian-W. Budde (Christian@pcjv.de)
27 *
28 * Portions created by the Initial Developer are Copyright (C) 2012
29 * the Initial Developer. All Rights Reserved.
30 *
31 * Contributor(s):
32 *
33 * ***** END LICENSE BLOCK ***** *)
34
35interface
36
37{$I GR32.inc}
38
39uses
40 Windows, Types, Math, D2D1, GR32, GR32_Paths;
41
42procedure TextToPath(Font: HFONT; const FontHeight: Integer; Path: TCustomPath;
43 const ARect: TFloatRect; const Text: WideString; Flags: Cardinal = 0);
44function TextToPolyPolygon(Font: HFONT; const FontHeight: Integer;
45 const ARect: TFloatRect; const Text: WideString;
46 Flags: Cardinal = 0): TArrayOfArrayOfFloatPoint;
47
48function MeasureTextDC(DC: HDC; const FontHeight: Integer;
49 const ARect: TFloatRect; const Text: WideString;
50 Flags: Cardinal = 0): TFloatRect; overload;
51function MeasureText(Font: HFONT; const FontHeight: Integer;
52 const ARect: TFloatRect; const Text: WideString;
53 Flags: Cardinal = 0): TFloatRect;
54
55type
56 TTextGeometrySink = class(TInterfacedObject, ID2D1SimplifiedGeometrySink, ID2D1GeometrySink)
57 private
58 FPath: TCustomPath;
59 FDstX, FDstY: TFloat;
60 public
61 constructor Create(Path: TCustomPath; DstX, DstY: TFloat);
62
63 procedure SetFillMode(fillMode: D2D1_FILL_MODE); stdcall;
64 procedure SetSegmentFlags(vertexFlags: D2D1_PATH_SEGMENT); stdcall;
65 procedure BeginFigure(startPoint: D2D1_POINT_2F;
66 figureBegin: D2D1_FIGURE_BEGIN); stdcall;
67 procedure AddLines(points: PD2D1Point2F; pointsCount: UINT); stdcall;
68 procedure AddBeziers(beziers: PD2D1BezierSegment;
69 beziersCount: UINT); stdcall;
70 procedure EndFigure(figureEnd: D2D1_FIGURE_END); stdcall;
71 function Close: HResult; stdcall;
72 procedure AddLine(point: D2D1_POINT_2F); stdcall;
73 procedure AddBezier(const bezier: D2D1_BEZIER_SEGMENT); stdcall;
74 procedure AddQuadraticBezier(const bezier: D2D1_QUADRATIC_BEZIER_SEGMENT); stdcall;
75 procedure AddQuadraticBeziers(beziers: PD2D1QuadraticBezierSegment;
76 beziersCount: UINT); stdcall;
77 procedure AddArc(const arc: D2D1_ARC_SEGMENT); stdcall;
78 end;
79
80const
81 DT_LEFT = 0; //See also Window's DrawText() flags ...
82 DT_CENTER = 1; //http://msdn.microsoft.com/en-us/library/ms901121.aspx
83 DT_RIGHT = 2;
84 DT_VCENTER = 4;
85 DT_BOTTOM = 8;
86 DT_WORDBREAK = $10;
87 DT_SINGLELINE = $20;
88 DT_NOCLIP = $100;
89 DT_JUSTIFY = 3; //Graphics32 additions ...
90 DT_HORZ_ALIGN_MASK = 3;
91
92implementation
93
94uses
95{$IFDEF USESTACKALLOC}
96 GR32_LowLevel,
97{$ENDIF}
98 ComObj,
99 SysUtils;
100
101type
102 IDWriteFontFaceFixed = interface(IUnknown)
103 [SID_IDWriteFontFace]
104 function GetType: DWRITE_FONT_FACE_TYPE; stdcall;
105
106 function GetFiles(var numberOfFiles: Cardinal;
107 out fontFiles: IDWriteFontFile): HResult; stdcall;
108
109 function GetIndex: UINT32; stdcall;
110
111 function GetSimulations: DWRITE_FONT_SIMULATIONS; stdcall;
112
113 function IsSymbolFont: BOOL; stdcall;
114
115 procedure GetMetrics(var fontFaceMetrics: TDwriteFontMetrics); stdcall;
116
117 function GetGlyphCount: UINT16; stdcall;
118
119 function GetDesignGlyphMetrics(glyphIndices: PWord; glyphCount: Cardinal;
120 glyphMetrics: PDwriteGlyphMetrics; isSideways: BOOL = False): HResult; stdcall;
121
122 function GetGlyphIndices(var codePoints: Cardinal; codePointCount: Cardinal;
123 var glyphIndices: Word): HResult; stdcall;
124
125 function TryGetFontTable(openTypeTableTag: Cardinal; var tableData: Pointer;
126 var tableSize: Cardinal; var tableContext: Pointer;
127 var exists: BOOL): HResult; stdcall;
128
129 procedure ReleaseFontTable(tableContext: Pointer); stdcall;
130
131 function GetGlyphRunOutline(emSize: Single; const glyphIndices: PWord;
132 const glyphAdvances: PSingle; const glyphOffsets: PDwriteGlyphOffset;
133 glyphCount: Cardinal; isSideways: BOOL; isRightToLeft: BOOL;
134 geometrySink: IDWriteGeometrySink): HResult; stdcall;
135
136 function GetRecommendedRenderingMode(emSize: Single; pixelsPerDip: Single;
137 measuringMode: TDWriteMeasuringMode;
138 var renderingParams: IDWriteRenderingParams;
139 var renderingMode: TDWriteRenderingMode): HResult; stdcall;
140
141 function GetGdiCompatibleMetrics(emSize: Single; pixelsPerDip: Single;
142 transform: PDwriteMatrix; var fontFaceMetrics: DWRITE_FONT_METRICS): HResult; stdcall;
143
144 function GetGDICompatibleGlyphMetrics(emSize: Single; pixelsPerDip: Single;
145 transform: PDwriteMatrix; useGdiNatural: BOOL;
146 glyphIndicies: PWord; glpyhCount: Cardinal;
147 out glyphMetrics: TDwriteGlyphMetrics; isSideways: BOOL = FALSE): HResult; stdcall;
148 end;
149
150
151const
152 MaxSingle = 3.4e+38;
153
154{ TTextGeometrySink }
155
156constructor TTextGeometrySink.Create(Path: TCustomPath; DstX, DstY: TFloat);
157begin
158 FPath := Path;
159 FDstX := DstX;
160 FDstY := DstY;
161end;
162
163function D2D_POINT_2F_to_TFloatPoint(Value: D2D_POINT_2F): TFloatPoint;
164begin
165 Result.X := Value.x;
166 Result.Y := Value.Y;
167end;
168
169procedure TTextGeometrySink.AddArc(const arc: D2D1_ARC_SEGMENT);
170begin
171// FPath.Arc(D2D_POINT_2F_to_TFloatPoint(arc.point), arc.rotationAngle, arc.);
172end;
173
174procedure TTextGeometrySink.AddBezier(const bezier: D2D1_BEZIER_SEGMENT);
175begin
176 FPath.CurveTo(
177 FDstX + bezier.point1.x, FDstY + bezier.point1.y,
178 FDstX + bezier.point2.x, FDstY + bezier.point2.y,
179 FDstX + bezier.point3.x, FDstY + bezier.point3.y);
180end;
181
182procedure TTextGeometrySink.AddBeziers(beziers: PD2D1BezierSegment;
183 beziersCount: UINT);
184var
185 Index: Integer;
186begin
187 for Index := 0 to beziersCount - 1 do
188 begin
189 FPath.CurveTo(
190 FDstX + beziers.point1.x, FDstY + beziers.point1.y,
191 FDstX + beziers.point2.x, FDstY + beziers.point2.y,
192 FDstX + beziers.point3.x, FDstY + beziers.point3.y);
193 Inc(Beziers);
194 end;
195end;
196
197procedure TTextGeometrySink.AddLine(point: D2D1_POINT_2F);
198begin
199 FPath.LineTo(FDstX + point.x, FDstY + point.y);
200end;
201
202procedure TTextGeometrySink.AddLines(points: PD2D1Point2F; pointsCount: UINT);
203var
204 Index: Integer;
205begin
206 for Index := 0 to pointsCount - 1 do
207 begin
208 FPath.LineTo(FDstX + points^.x, FDstY + points^.Y);
209 Inc(points);
210 end;
211end;
212
213procedure TTextGeometrySink.AddQuadraticBezier(
214 const bezier: D2D1_QUADRATIC_BEZIER_SEGMENT);
215begin
216 FPath.CurveTo(
217 FDstX + bezier.point1.x, FDstY + bezier.point1.y,
218 FDstX + bezier.point2.x, FDstY + bezier.point2.y);
219end;
220
221procedure TTextGeometrySink.AddQuadraticBeziers(
222 beziers: PD2D1QuadraticBezierSegment; beziersCount: UINT);
223var
224 Index: Integer;
225begin
226 for Index := 0 to beziersCount - 1 do
227 begin
228 FPath.CurveTo(
229 FDstX + beziers^.point1.x, FDstY + beziers^.point1.y,
230 FDstX + beziers^.point2.x, FDstY + beziers^.point2.y);
231 Inc(Beziers);
232 end;
233end;
234
235procedure TTextGeometrySink.BeginFigure(startPoint: D2D1_POINT_2F;
236 figureBegin: D2D1_FIGURE_BEGIN);
237begin
238 FPath.MoveTo(FDstX + startPoint.x, FDstY + startPoint.Y);
239end;
240
241function TTextGeometrySink.Close: HResult;
242begin
243 Result := S_OK;
244end;
245
246procedure TTextGeometrySink.EndFigure(figureEnd: D2D1_FIGURE_END);
247begin
248 FPath.EndPath(True);
249end;
250
251procedure TTextGeometrySink.SetFillMode(fillMode: D2D1_FILL_MODE);
252begin
253end;
254
255procedure TTextGeometrySink.SetSegmentFlags(vertexFlags: D2D1_PATH_SEGMENT);
256begin
257
258end;
259
260var
261 SingletonD2DFactory: ID2D1Factory;
262
263function D2DFactory(FactoryType: TD2D1FactoryType = D2D1_FACTORY_TYPE_SINGLE_THREADED;
264 FactoryOptions: PD2D1FactoryOptions = nil): ID2D1Factory;
265var
266 LD2DFactory: ID2D1Factory;
267begin
268 if SingletonD2DFactory = nil then
269 begin
270 D2D1CreateFactory(FactoryType, IID_ID2D1Factory, FactoryOptions, LD2DFactory);
271 if InterlockedCompareExchangePointer(Pointer(SingletonD2DFactory), Pointer(LD2DFactory), nil) = nil then
272 LD2DFactory._AddRef;
273 end;
274 Result := SingletonD2DFactory;
275end;
276
277var
278 SingletonDWriteFactory: IDWriteFactory;
279
280function DWriteFactory(FactoryType: TDWriteFactoryType = DWRITE_FACTORY_TYPE_SHARED): IDWriteFactory;
281var
282 LDWriteFactory: IDWriteFactory;
283begin
284 if SingletonDWriteFactory = nil then
285 begin
286 DWriteCreateFactory(FactoryType, IID_IDWriteFactory, IUnknown(LDWriteFactory));
287 if InterlockedCompareExchangePointer(Pointer(SingletonDWriteFactory), Pointer(LDWriteFactory), nil) = nil then
288 LDWriteFactory._AddRef;
289 end;
290 Result := SingletonDWriteFactory;
291end;
292
293
294procedure InternalTextToPath(DC: HDC; FontHeight: Integer;
295 Path: TCustomPath; const ARect: TFloatRect;
296 const Text: WideString; Flags: Cardinal = 0);
297const
298 CHAR_CR = 10;
299 CHAR_NL = 13;
300 CHAR_SP = 32;
301var
302 I, J, TextLen, SpcCount, SpcX, LineStart: Integer;
303 CharValue: Integer;
304 CharAdvance: TFloat;
305 CharOffsets: TArrayOfInteger;
306 CharWidths: TArrayOfInteger;
307 X, Y, XMax, YMax, MaxRight: Single;
308 S: WideString;
309 UseTempPath: Boolean;
310 TextPath: TFlattenedPath;
311 OwnedPath: TFlattenedPath;
312 EmSize, PixelPerDip: Single;
313
314 GDIInterop: IDWriteGdiInterop;
315 Metrics: TDwriteFontMetrics;
316 GlyphMetrics: TDwriteGlyphMetrics;
317 GlyphIndex: Word;
318 TextGeometrySink: TTextGeometrySink;
319 FontFace: IDWriteFontFace;
320 HR: HRESULT;
321 CurrentChar: Word;
322
323 procedure AlignTextCenter(CurrentI: Integer);
324 var
325 w, M, N, PathStart, PathEnd, CharStart, CharEnd: Integer;
326 Delta: TFloat;
327 i: Integer;
328 MinX, MaxX: Single;
329 begin
330 Delta := Round(((ARect.Right - ARect.Left) - X - 1) * 0.5);
331 PathStart := CharOffsets[LineStart];
332 PathEnd := CharOffsets[CurrentI] - 1;
333 if (Flags and DT_SINGLELINE <> 0) and (Flags and DT_NOCLIP <> DT_NOCLIP) then
334 begin
335 MinX := ARect.Left + Delta;
336 MaxX := ARect.Right + Delta;
337 CharStart := LineStart;
338 CharEnd := CurrentI;
339
340 w := Round(Delta);
341 for i := LineStart to CurrentI - 1 do
342 begin
343 if w < Arect.Left then
344 begin
345 CharStart := i + 1;
346 MinX := w + CharWidths[i];
347 end;
348 w := w + CharWidths[i];
349 if w <= ARect.Right then
350 begin
351 CharEnd := i + 1;
352 MaxX := w;
353 end;
354 end;
355
356 if (Flags and DT_WORDBREAK <> 0) then
357 begin
358 if (CharStart > LineStart) and (Text[CharStart] <> ' ') then
359 while (Text[CharStart] <> ' ') and (CharStart < CharEnd) do
360 Inc(CharStart);
361 if (CharEnd < CurrentI) and (Text[CharEnd] <> ' ') then
362 while (Text[CharEnd] <> ' ') and (CharEnd > CharStart) do
363 Dec(CharEnd);
364 MinX:= Round(Delta);
365 for i := 0 to CharStart - 1 do
366 MinX := MinX + CharWidths[i];
367 MaxX := Round(Delta);
368 for i := 0 to CharEnd - 1 do
369 MaxX := MaxX + CharWidths[i];
370 end;
371
372 PathStart := CharOffsets[CharStart];
373 PathEnd := CharOffsets[CharEnd] - 1;
374
375 for M := 0 to PathStart - 1 do
376 SetLength(TextPath.Path[M], 0);
377 for M := PathEnd + 1 to CharOffsets[CurrentI] - 1 do
378 SetLength(TextPath.Path[M], 0);
379
380 Delta := Delta + (((MinX - ARect.Left) + (ARect.Right - MaxX)) * 0.5) - MinX;
381 end;
382 for M := PathStart to PathEnd do
383 for N := 0 to High(TextPath.Path[M]) do
384 TextPath.Path[M, N].X := TextPath.Path[M, N].X + Delta;
385 end;
386
387 procedure AlignTextRight(CurrentI: Integer);
388 var
389 w, i, M, N, PathStart, PathEnd, CharStart: Integer;
390 Delta: TFloat;
391 begin
392 Delta := Round(ARect.Right - X - 1);
393 PathStart := CharOffsets[LineStart];
394 PathEnd := CharOffsets[CurrentI] - 1;
395
396 if (Flags and DT_SINGLELINE <> 0) and (Flags and DT_NOCLIP <> DT_NOCLIP) then
397 begin
398 CharStart := LineStart;
399
400 w := 0;
401 for i := LineStart to CurrentI - 1 do
402 begin
403 if w + Delta < Arect.Left then
404 CharStart:= i + 1;
405 w := w + CharWidths[i];
406 end;
407
408 if (Flags and DT_WORDBREAK <> 0) then
409 if (CharStart > LineStart) and (Text[CharStart] <> ' ') then
410 while (Text[CharStart] <> ' ') and (CharStart < CurrentI) do
411 Inc(CharStart);
412
413 PathStart := CharOffsets[CharStart];
414
415 for M := 0 to PathStart - 1 do
416 SetLength(TextPath.Path[M], 0);
417 end;
418
419 for M := PathStart to PathEnd do
420 for N := 0 to High(TextPath.Path[M]) do
421 TextPath.Path[M, N].X := TextPath.Path[M, N].X + Delta;
422 end;
423
424 procedure AlignTextLeft(CurrentI: Integer);
425 var
426 w, i, M, PathEnd, CharEnd: Integer;
427 begin
428 if (Flags and DT_SINGLELINE <> 0) and (Flags and DT_NOCLIP <> DT_NOCLIP) then
429 begin
430 CharEnd := LineStart;
431
432 w := 0;
433 for i := LineStart to CurrentI - 1 do
434 begin
435 w := w + CharWidths[i];
436 if w <= (ARect.Right - ARect.Left) then
437 CharEnd:= i + 1;
438 end;
439
440 if (Flags and DT_WORDBREAK <> 0) then
441 if (CharEnd < CurrentI) and (Text[CharEnd] <> ' ') then
442 while (Text[CharEnd] <> ' ') and (CharEnd > LineStart) do
443 Dec(CharEnd);
444
445 PathEnd := CharOffsets[CharEnd] - 1;
446
447 for M := PathEnd + 1 to CharOffsets[CurrentI] - 1 do
448 SetLength(TextPath.Path[M], 0);
449 end;
450 end;
451
452 procedure AlignTextJustify(CurrentI: Integer);
453 var
454 L, M, N, PathStart, PathEnd: Integer;
455 SpcDelta, SpcDeltaInc: TFloat;
456 begin
457 if (SpcCount < 1) or (Ord(Text[CurrentI]) = CHAR_CR) then
458 Exit;
459 SpcDelta := (ARect.Right - X - 1) / SpcCount;
460 SpcDeltaInc := SpcDelta;
461 L := LineStart;
462
463 // Trim leading spaces ...
464 while (L < CurrentI) and (Ord(Text[L]) = CHAR_SP) do Inc(L);
465 // Now find first space char in line ...
466 while (L < CurrentI) and (Ord(Text[L]) <> CHAR_SP) do Inc(L);
467 PathStart := CharOffsets[L - 1];
468 repeat
469 M := L + 1;
470 while (M < CurrentI) and (Ord(Text[M]) <> CHAR_SP) do Inc(M);
471 PathEnd := CharOffsets[M];
472 L := M;
473 for M := PathStart to PathEnd - 1 do
474 for N := 0 to High(TextPath.Path[M]) do
475 TextPath.Path[M, N].X := TextPath.Path[M, N].X + SpcDeltaInc;
476 SpcDeltaInc := SpcDeltaInc + SpcDelta;
477 PathStart := PathEnd;
478 until L >= CurrentI;
479 end;
480
481 procedure AlignLine(CurrentI: Integer);
482 begin
483 if Assigned(TextPath) and (Length(TextPath.Path) > 0) then
484 case (Flags and DT_HORZ_ALIGN_MASK) of
485 DT_LEFT : AlignTextLeft(CurrentI);
486 DT_CENTER : AlignTextCenter(CurrentI);
487 DT_RIGHT : AlignTextRight(CurrentI);
488 DT_JUSTIFY: AlignTextJustify(CurrentI);
489 end;
490 end;
491
492 procedure AddSpace;
493 begin
494 Inc(SpcCount);
495 X := X + SpcX;
496 end;
497
498 procedure NewLine(CurrentI: Integer);
499 begin
500 if (Flags and DT_SINGLELINE <> 0) then
501 begin
502 AddSpace;
503 Exit;
504 end;
505 AlignLine(CurrentI);
506 X := ARect.Left;
507 Y := Y + (Metrics.ascent + Metrics.descent) / Metrics.designUnitsPerEm * EmSize * PixelPerDip; // was tmHeight
508 LineStart := CurrentI;
509 SpcCount := 0;
510 end;
511
512 function MeasureTextX(const S: WideString): Integer;
513 var
514 I: Integer;
515 begin
516 Result := 0;
517 for I := 1 to Length(S) do
518 begin
519 CharValue := Ord(S[I]);
520 IDWriteFontFaceFixed(FontFace).GetGDICompatibleGlyphMetrics(EmSize,
521 PixelPerDip, nil, True, @CharValue, 1, GlyphMetrics);
522 Inc(Result, Round(GlyphMetrics.advanceWidth / Metrics.designUnitsPerEm * EmSize * PixelPerDip));
523 end;
524 end;
525
526 function NeedsNewLine(X: Single): Boolean;
527 begin
528 Result := (ARect.Right > ARect.Left) and (X > ARect.Right);
529 end;
530
531begin
532 // get interoperability layer
533 HR := DWriteFactory.GetGdiInterop(GDIInterop);
534 OleCheck(HR);
535
536 // get font face from GDI
537 HR := GDIInterop.CreateFontFaceFromHdc(DC, FontFace);
538 OleCheck(HR);
539
540 FontFace.GetMetrics(Metrics);
541 EmSize := FontHeight * 96 / 72;
542 PixelPerDip := 1;
543
544 SpcCount := 0;
545 LineStart := 0;
546 OwnedPath := nil;
547 if (Path <> nil) then
548 begin
549 if (Path is TFlattenedPath) then
550 begin
551 TextPath := TFlattenedPath(Path);
552 TextPath.Clear;
553 end
554 else
555 begin
556 OwnedPath := TFlattenedPath.Create;
557 TextPath := OwnedPath;
558 end
559 end else
560 TextPath := nil;
561
562 TextLen := Length(Text);
563 X := ARect.Left;
564 Y := ARect.Top + Metrics.ascent / Metrics.designUnitsPerEm * EmSize * PixelPerDip;
565 XMax := X;
566
567 if not Assigned(Path) or (ARect.Right = ARect.Left) then
568 MaxRight := MaxSingle //either measuring Text or unbounded Text
569 else
570 MaxRight := ARect.Right;
571 SetLength(CharOffsets, TextLen + 1);
572 CharOffsets[0] := 0;
573 SetLength(CharWidths, TextLen);
574
575 CurrentChar := CHAR_SP;
576 IDWriteFontFaceFixed(FontFace).GetGDICompatibleGlyphMetrics(EmSize,
577 PixelPerDip, nil, True, PWORD(@CurrentChar), 1, GlyphMetrics);
578 SpcX := Round(GlyphMetrics.advanceWidth / Metrics.designUnitsPerEm * EmSize * PixelPerDip); // was gmCellIncX
579
580 if (Flags and DT_SINGLELINE <> 0) or (ARect.Left = ARect.Right) then
581 begin
582 // ignore justify when forcing singleline ...
583 if (Flags and DT_JUSTIFY = DT_JUSTIFY) then
584 Flags := Flags and not DT_JUSTIFY;
585
586 // ignore wordbreak when forcing singleline ...
587 //if (Flags and DT_WORDBREAK = DT_WORDBREAK) then
588 // Flags := Flags and not DT_WORDBREAK;
589 MaxRight := MaxSingle;
590 end;
591
592 // Batch whole path construction so we can be sure that the path isn't rendered
593 // while we're still modifying it.
594 if (TextPath <> nil) then
595 TextPath.BeginUpdate;
596
597 for I := 1 to TextLen do
598 begin
599 CharValue := Ord(Text[I]);
600 if CharValue <= 32 then
601 begin
602 if (Flags and DT_SINGLELINE = DT_SINGLELINE) then
603 CharValue := CHAR_SP;
604 if Assigned(TextPath) then
605 CharOffsets[I] := Length(TextPath.Path);
606 CharWidths[i - 1]:= SpcX;
607 case CharValue of
608 CHAR_CR: NewLine(I);
609 CHAR_NL: ;
610 CHAR_SP:
611 begin
612 if Flags and DT_WORDBREAK = DT_WORDBREAK then
613 begin
614 J := I + 1;
615 while (J <= TextLen) and
616 ([Ord(Text[J])] * [CHAR_CR, CHAR_NL, CHAR_SP] = []) do
617 Inc(J);
618 S := Copy(Text, I, J - I);
619 if NeedsNewLine(X + MeasureTextX(S)) then
620 NewLine(I) else
621 AddSpace;
622 end else
623 begin
624 if NeedsNewLine(X + SpcX) then
625 NewLine(I)
626 else
627 AddSpace;
628 end;
629 end;
630 end;
631 end
632 else
633 begin
634 HR := FontFace.GetGlyphIndices(Cardinal(CharValue), 1, GlyphIndex);
635 OleCheck(HR);
636
637 HR := IDWriteFontFaceFixed(FontFace).GetGDICompatibleGlyphMetrics(EmSize,
638 PixelPerDip, nil, True, @GlyphIndex, 1, GlyphMetrics);
639 OleCheck(HR);
640
641 CharAdvance := GlyphMetrics.advanceWidth / Metrics.designUnitsPerEm * EmSize * PixelPerDip;
642
643 if X + CharAdvance <= MaxRight then
644 begin
645 TextGeometrySink := TTextGeometrySink.Create(TextPath, X, Y);
646 try
647 HR := FontFace.GetGlyphRunOutline(EmSize, @GlyphIndex, nil, nil, 1,
648 False, False, TextGeometrySink);
649 OleCheck(HR);
650 finally
651 TextGeometrySink.Free;
652 end;
653
654 if Assigned(TextPath) then
655 CharOffsets[I] := Length(TextPath.Path);
656 CharWidths[I - 1] := Round(CharAdvance);
657 end
658 else
659 begin
660 if Ord(Text[I - 1]) = CHAR_SP then
661 begin
662 // this only happens without DT_WORDBREAK
663 X := X - SpcX;
664 Dec(SpcCount);
665 end;
666 // the current glyph doesn't fit so a word must be split since
667 // it fills more than a whole line ...
668 NewLine(I - 1);
669
670 TextGeometrySink := TTextGeometrySink.Create(TextPath, X, Y);
671 try
672 HR := FontFace.GetGlyphRunOutline(EmSize, @GlyphIndex, nil, nil, 1,
673 False, False, TextGeometrySink);
674 OleCheck(HR);
675 finally
676 TextGeometrySink.Free;
677 end;
678
679 if Assigned(TextPath) then
680 CharOffsets[I] := Length(TextPath.Path);
681 CharWidths[I - 1] := Round(CharAdvance);
682 end;
683
684 X := X + CharAdvance;
685 if X > XMax then XMax := X;
686 end;
687 end;
688 if [(Flags and DT_HORZ_ALIGN_MASK)] * [DT_LEFT, DT_CENTER, DT_RIGHT] <> [] then
689 AlignLine(TextLen);
690
691 YMax := Y + Metrics.descent / Metrics.designUnitsPerEm * EmSize * PixelPerDip;
692
693 X := ARect.Right - XMax;
694 Y := ARect.Bottom - YMax;
695 if Flags and (DT_VCENTER or DT_BOTTOM) <> 0 then
696 begin
697 if Flags and DT_VCENTER <> 0 then
698 Y := Y * 0.5;
699 if Assigned(TextPath) then
700 for I := 0 to High(TextPath.Path) do
701 for J := 0 to High(TextPath.Path[I]) do
702 TextPath.Path[I, J].Y := TextPath.Path[I, J].Y + Y;
703 end;
704
705 if (Path <> nil) then
706 begin
707 TextPath.EndPath; // TODO : Why is this needed?
708
709 if (Path <> TextPath) then
710 Path.Assign(TextPath);
711
712 TextPath.EndUpdate;
713
714 OwnedPath.Free;
715 end;
716end;
717
718procedure TextToPath(Font: HFONT; const FontHeight: Integer; Path: TCustomPath;
719 const ARect: TFloatRect; const Text: WideString; Flags: Cardinal = 0);
720var
721 DC: HDC;
722 SavedFont: HFONT;
723begin
724 DC := GetDC(0);
725 try
726 SavedFont := SelectObject(DC, Font);
727 InternalTextToPath(DC, FontHeight, Path, ARect, Text, Flags);
728 SelectObject(DC, SavedFont);
729 finally
730 ReleaseDC(0, DC);
731 end;
732end;
733
734function TextToPolyPolygon(Font: HFONT; const FontHeight: Integer;
735 const ARect: TFloatRect; const Text: WideString;
736 Flags: Cardinal = 0): TArrayOfArrayOfFloatPoint;
737var
738 Path: TFlattenedPath;
739begin
740 Path := TFlattenedPath.Create;
741 try
742 TextToPath(Font, FontHeight, Path, ARect, Text, Flags);
743 Result := Path.Path;
744 finally
745 Path.Free;
746 end;
747end;
748
749function MeasureTextDC(DC: HDC; const FontHeight: Integer; const ARect: TFloatRect;
750 const Text: WideString; Flags: Cardinal): TFloatRect;
751begin
752 Result := ARect;
753 InternalTextToPath(DC, FontHeight, nil, Result, Text, Flags);
754 Result.Left := Round(Result.Left);
755 Result.Top := Round(Result.Top);
756 Result.Right := Round(Result.Right);
757 Result.Bottom := Round(Result.Bottom);
758end;
759
760function MeasureText(Font: HFONT; const FontHeight: Integer;
761 const ARect: TFloatRect; const Text: WideString; Flags: Cardinal): TFloatRect;
762var
763 DC: HDC;
764 SavedFont: HFONT;
765begin
766 DC := GetDC(0);
767 try
768 SavedFont := SelectObject(DC, Font);
769 Result := MeasureTextDC(DC, FontHeight, ARect, Text, Flags);
770 SelectObject(DC, SavedFont);
771 finally
772 ReleaseDC(0, DC);
773 end;
774end;
775
776end.
Note: See TracBrowser for help on using the repository browser.