在 Visual Basic 6 中以一点为中心绘制旋转文本

标题 在 Visual Basic 6 中以一点为中心绘制旋转文本 描述 此示例显示如何在 Visual Basic 6 中绘制以某个点为中心的旋转文本 关键词 旋转文本、居中文本、CreateFont 类别 图形

Option Explicit Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal i As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long Private Const LOGPIXELSY = 90 ' Logical pixels/inch in Y Private Sub DrawCenteredRotatedText(ByVal pic As PictureBox, _ ByVal txt As String, _ ByVal X As Single, _ ByVal Y As Single, _ ByVal angle As Single, _ ByVal font_points As Integer) Const CLIP_LH_ANGLES As Long = 16 ' Needed for tilted fonts. Const PI As Single = 3.14159265 Dim font_units As Single Dim escapement As Long Dim oldfont As Long Dim newfont As Long Dim wid As Single Dim hgt As Single Dim wx As Single Dim wy As Single Dim hx As Single Dim hy As Single Dim theta As Single Dim ox As Single Dim oy As Single font_units = font_points * GetDeviceCaps(pic.hdc, LOGPIXELSY) / 72 escapement = CLng(angle * 10) newfont = CreateFont(CLng(font_units), 0, escapement, escapement, 700, False, False, False, 0, 0, CLIP_LH_ANGLES, 0, 0, "Times New Roman") ' Select the new font. oldfont = SelectObject(pic.hdc, newfont) ' Get the text width. wid = pic.TextWidth(txt) ' Convert the font height in points into twips. hgt = pic.ScaleY(font_points, vbPoints, vbTwips) theta = -angle * PI / 180 ' Negate because y increases downward. wx = wid * Cos(theta) / 2 wy = wid * Sin(theta) / 2 hx = -hgt * Sin(theta) / 2 hy = hgt * Cos(theta) / 2 ' Find the rotated origin. ox = X - wx - hx oy = Y - wy - hy ' Display the text. pic.CurrentX = ox pic.CurrentY = oy pic.Print txt ' Restore the original font. newfont = SelectObject(pic.hdc, oldfont) ' Free font resources (important!) DeleteObject newfont ' Draw the center point. pic.Circle (X, Y), 30, vbRed ' Draw the rotated bounding box. pic.CurrentX = X - wx - hx pic.CurrentY = Y - wy - hy pic.Line -(X + wx - hx, Y + wy - hy), vbRed pic.Line -(X + wx + hx, Y + wy + hy), vbRed pic.Line -(X - wx + hx, Y - wy + hy), vbRed pic.Line -(X - wx - hx, Y - wy - hy), vbRed End Sub Private Sub Form_Load() Dim i As Integer picCanvas.AutoRedraw = True For i = 0 To 200 Step 40 DrawCenteredRotatedText picCanvas, Format$(i), 300 + i * 30, 600, i, 40 Next i End Sub Private Sub Form_Resize() picCanvas.Move 0, 0, ScaleWidth, ScaleHeight End Sub

子程序 DrawCenteredRotatedText 绘制居中旋转的文本。它首先将以磅为单位的字体大小转换为逻辑字体单位。然后它使用 CreateFont 制作一个适当旋转的字体并选择它。 然后该例程以缇为单位（PictureBox 的单位）获取文本的大小。它使用一些三角函数来获得向量 和 指向文本旋转宽度和高度的方向。它使用这些向量来计算文本的原点应该在哪里使文本居中并绘制文本。 代码通过绘制中心并使用向量绘制边界框来显示文本的绘制位置。