uses Direct2D, D2D1; var iTextLayout: IDWriteTextLayout; {构建 DWRITE_TEXT_RANGE 结构的函数} function DWriteTextRange(pos,len: Cardinal): TDwriteTextRange; begin Result.startPosition := pos; Result.length := len; end; {建立 IDWriteTextLayout} procedure TForm1.FormCreate(Sender: TObject); var str: string; iTextFormat: IDWriteTextFormat; begin str := 'Click on this text.'; DWriteFactory.CreateTextFormat( 'Verdana', nil, DWRITE_FONT_WEIGHT_REGULAR, DWRITE_FONT_STYLE_NORMAL, DWRITE_FONT_STRETCH_NORMAL, 48.0, 'en-us', iTextFormat ); iTextFormat.SetTextAlignment(DWRITE_TEXT_ALIGNMENT_CENTER); iTextFormat.SetParagraphAlignment(DWRITE_PARAGRAPH_ALIGNMENT_CENTER); DWriteFactory.CreateTextLayout( PWideChar(str), Length(str), iTextFormat, ClientWidth, ClientHeight, iTextLayout ); end; {命中测试} procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var bTrailingHit, bInside: BOOL; rTestMetrics: TDWriteHitTestMetrics; begin iTextLayout.HitTestPoint( X, Y, //给出位置 bTrailingHit, //输出布尔值, 表示当前位置是在命中区域的前端还是后端 bInside, //输出布尔值, 表示当前位置是在命中区域的内部还是外部 rTestMetrics //命中区域的信息结构 ); iTextLayout.SetUnderline(False, DWriteTextRange(0, MaxInt)); //全部取消下划线 iTextLayout.SetUnderline(True, DWriteTextRange(rTestMetrics.textPosition, 1)); //给命中的区域添加下划线 // Text := Format('TrailingHit: %d, Inside: %d', [Integer(bTrailingHit), Integer(bInside)]); Repaint; end; {使用 RenderTarget.DrawTextLayout() 方法绘制文本} procedure TForm1.FormPaint(Sender: TObject); var cvs: TDirect2DCanvas; iBrush: ID2D1SolidColorBrush; begin cvs := TDirect2DCanvas.Create(Canvas, ClientRect); cvs.RenderTarget.BeginDraw; cvs.RenderTarget.Clear(D2D1ColorF(clWhite)); cvs.RenderTarget.CreateSolidColorBrush(D2D1ColorF(clBlack), nil, iBrush); cvs.RenderTarget.DrawTextLayout(D2D1PointF(0,0), iTextLayout, iBrush); cvs.RenderTarget.EndDraw(); cvs.Free; end; {刷新数据及重绘} procedure TForm1.FormResize(Sender: TObject); begin FormCreate(nil); Repaint; end;
效果图: