如何使用 Delphi 10.2 在画布中垂直 + 水平绘制文本

Question

我想在画布上垂直绘制一个单词，并在它旁边水平绘制一个单词。我使用了这样的旧建议：

在 maiForm 的创建事件中：

GetObject(MainForm.Font.Handle,SizeOf(TLogFont),@LogFont);
NewLogFont := LogFont;
NewLogFont.lfEscapement := 900;
NewFont := CreateFontIndirect(NewLogFont);
OldFont := MainForm.Font.Handle;

在哪里

LogFont,NewLogFont  : TLogFont;
NewFont,OldFont     : HFont;

并在绘图程序中：

fontTemp := TFont.Create;
fontTemp.Assign(aCanvas.Font);
......
aCanvas.Font.Handle := newFont; // if i coment this line the two strings drawn verically else both drawn horizonatlly
aCanvas.Font.Size := 8;
h := textHeight('1');
aCanvas.textOut(x,y,aString);
aCanvas.Font.Assign(fontTemp);
aCanvas.textOut(x+20,y,bString);
.....
fontTemp.Free;

在我的旧应用程序 (D2007) 中，它运行正常，但在 Delphi 10.2 中，方向的变化（从 vert 到 horiz）会将两个字符串都更改为 horiz。请问有什么帮助吗？

Answer 1

不，正如你所说，这不是一个绝对罕见的代码。这种方法使您可以在不使用VCL的画布属性的情况下旋转文本。

用于带旋转的输出文本的纯 WinAPI

下面的代码使用 noVCL的功能将旋转文本输出到提供的设备上下文 ( HDC)。

procedure TForm1.DrawTextRotatedA(ADC: HDC; AFontHandle: HFONT; 
  Angle, X, Y: Integer; AColor: COLORREF; AText: String);
var
  LogFont: tagLOGFONT;
  OldFontHandle: HFONT;
  NewFontHandle: HFONT;
begin
  if (ADC = 0) or (AFontHandle = 0) then
    Exit;

  if GetObject(AFontHandle, SizeOf(LogFont), @LogFont) = 0 then
    Exit;

  // Set color of text and its rotation angle
  SetTextColor(ADC, AColor);
  if Angle > 360 then
    Angle := 0;
  LogFont.lfEscapement := Angle * 10;
  LogFont.lfCharset := 1;
  LogFont.lfOutPrecision := OUT_TT_PRECIS;
  LogFont.lfQuality := PROOF_QUALITY;

  // Create new font
  NewFontHandle := CreateFontIndirect(LogFont);
  try
    OldFontHandle := SelectObject(ADC, NewFontHandle);
    try
      // Output result
      SetBKMode(ADC, TRANSPARENT);
      try
        TextOut(ADC, X, Y, LPCWSTR(AText), Length(AText));
      finally
        SetBKMode(ADC, OPAQUE);
      end;
    finally
      // Restore font handle
      NewFontHandle := SelectObject(ADC, OldFontHandle);
    end;
  finally
    // Delete font handle
    DeleteObject(NewFontHandle);
  end;
end;

有改进的地方，但是这仅仅是一个例子来证明你是错的调用这样的代码罕见。此示例期望HFONT作为参数之一对其执行所有操作。您可能可以TControl通过使用WM_GETFONTmessage来获取字体句柄，但是VCL's 的大多数组件不接受此消息（它可以工作，feTListView返回正确的字体句柄）。尝试从HDC返回的System字体中获取字体句柄根本不支持旋转。也许我做错了什么，但我已经采取了相应的行动microsoft.docs。

使用 VCL 输出带旋转的文本

我没有得到您在问题中提供的代码应该做什么（它无法编译）所以我重写它以向您展示如何使用 VCL 的功能输出旋转文本。

procedure TForm1.DrawTextRotatedB(ACanvas: TCanvas; Angle, X, Y: Integer; 
  ATextColor: TColor; AText: String);
var
  NewX: Integer;
  NewY: integer;
  Escapement: Integer;
  LogFont: TLogFont;
  NewFontHandle: HFONT;
  OldFontHandle: HFONT;
begin
  if not Assigned(ACanvas) then
    Exit;

  // Get handle of font and prepare escapement
  GetObject(ACanvas.Font.Handle, SizeOf(LogFont), @LogFont);
  if Angle > 360 then
    Angle := 0;
  Escapement := Angle * 10;

  // We must initialise all fields of the record structure
  LogFont.lfWidth := 0;
  LogFont.lfHeight := ACanvas.Font.Height;
  LogFont.lfEscapement := Escapement;
  LogFont.lfOrientation := 0;
  if fsBold in ACanvas.Font.Style then
    LogFont.lfWeight := FW_BOLD
  else
    LogFont.lfWeight := FW_NORMAL;
  LogFont.lfItalic := Byte(fsItalic in ACanvas.Font.Style);
  LogFont.lfUnderline := Byte(fsUnderline in ACanvas.Font.Style);
  LogFont.lfStrikeOut := Byte(fsStrikeOut in ACanvas.Font.Style);
  LogFont.lfCharSet := ACanvas.Font.Charset;
  LogFont.lfOutPrecision := OUT_DEFAULT_PRECIS;
  LogFont.lfClipPrecision := CLIP_DEFAULT_PRECIS;
  LogFont.lfQuality := DEFAULT_QUALITY;
  LogFont.lfPitchAndFamily := DEFAULT_PITCH;
  StrPCopy(LogFont.lfFaceName, ACanvas.Font.Name);

  // Create new font with rotation
  NewFontHandle := CreateFontIndirect(LogFont);
  try
    // Set color of text
    ACanvas.Font.Color := ATextColor;

    // Select the new font into the canvas
    OldFontHandle := SelectObject(ACanvas.Handle, NewFontHandle);
    try
      // Output result
      ACanvas.Brush.Style := VCL.Graphics.bsClear;
      try
        ACanvas.TextOut(X, Y, AText);
      finally
        ACanvas.Brush.Style := VCL.Graphics.bsSolid;
      end;
    finally
      // Restore font handle
      NewFontHandle := SelectObject(ACanvas.Handle, OldFontHandle);
    end;
  finally
    // Delete the deselected font object
    DeleteObject(NewFontHandle);
  end;
end;

使用案例

这是显示如何使用旋转文本过程的代码。

procedure TForm1.aButton1Click(Sender: TObject);
var
  DC: HDC;
begin
  Repaint;

  DC := GetDC(Handle);
  try
    DrawTextRotatedA(DC, Canvas.Font.Handle, TrackBar1.Position, 100, 100, clNavy, 'String');
  finally
    ReleaseDC(Handle, DC);
  end;

  DrawTextRotatedB(Canvas, TrackBar1.Position, 200, 100, clNavy, 'String');
end;

有时在没有 VCL 的情况下将旋转文本输出到 DC 会更快。如果您尝试处理无法访问画布的控件，这可能很有用。Fe 如果您尝试以自己的风格绘制tooltip( tooltip_class32)，您可能希望使用第一种方法来输出文本（旋转或不旋转）。

信息

以下是来自 的链接docs.microsoft。它们描述了使用一种或另一种功能的方式和原因。

• 关于设备上下文
• TextOutW 函数
• SetTextColor 函数
• tagLOGFONTW 结构
• 获取对象函数
• WM_GETFONT 消息