VB6.0字符串圆形排列并旋转文字

‘VB6.0字符串圆形排列并旋转文字
’ 在Form1上添加一个PictureBox控件，命名为Picture1
’ 并设置其AutoRedraw属性为True，ScaleMode属性为Pixels
’ 以及适当的Width和Height

Option Explicit
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) 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 SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function SetWorldTransform Lib "gdi32" (ByVal hdc As Long, lpXform As xform) As Long
Private Declare Function ModifyWorldTransform Lib "gdi32" (ByVal hdc As Long, lpXform As xform, ByVal iMode As Long) As Long
Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function StrokePath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function ArcTo Lib "gdi32" (ByVal hdc As Long, ByVal left As Long, ByVal top As Long, ByVal right As Long, ByVal bottom As Long, ByVal xStartArc As Long, ByVal yStartArc As Long, ByVal xEndArc As Long, ByVal yEndArc As Long) As Long
Private Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName As String * 32
End Type
Private Type xform
    eM11 As Single
    eM12 As Single
    eM21 As Single
    eM22 As Single
    eDx As Single
    eDy As Single
End Type
Private Const TRANSPARENT = 1
Private Const MWT_IDENTITY = 1
Private Const MWT_LEFTMULTIPLY = 2
Private Sub Form_Load()
    Picture1.BackColor = &HFFFFFF ' 设置PictureBox的背景色
    Picture1_Paint ' 触发Paint事件以绘制弧形文本
End Sub
Private Sub Picture1_Paint()
    Dim centerX As Integer, centerY As Integer
    Dim radius As Integer
    Dim startAngle As Single, angleIncrement As Single
    Dim text As String
    Dim i As Integer
    Dim charWidth As Integer
    Dim x As Single, y As Single
    Dim angle As Single
    Dim radian As Single
    Dim lf As LOGFONT 'LOGFONT结构体和字体变量
    Dim hFont As Long
    Dim hOldFont As Long
    centerX = Picture1.ScaleWidth / 2 ' 设置弧形参数
    centerY = Picture1.ScaleHeight / 2 ' 设置弧形参数
    radius = 100 ' 弧形半径
    startAngle = 90 ' 起始角度（从上方开始，顺时针方向）
    text = "圆形排列并旋转文字"
    angleIncrement = 360 / Len(text) ' 每个字符之间的角度增量
    Picture1.Cls ' 清除画布
    lf.lfFaceName = "黑体" & vbNullChar ' 设置字体
    lf.lfHeight = -Picture1.ScaleHeight / 10 ' 字体高度
    lf.lfWeight = 400 ' 字体粗细
    hFont = CreateFontIndirect(lf)
    hOldFont = SelectObject(Picture1.hdc, hFont)
    SetBkMode Picture1.hdc, TRANSPARENT ' 设置文本模式
    SetTextColor Picture1.hdc, RGB(0, 0, 0) ' 设置文本颜色
    For i = 1 To Len(text) ' 绘制弧形文本
        angle = startAngle - (i - 1) * angleIncrement ' 计算当前字符的角度
        radian = angle * (3.14159265358979 / 180) ' 将角度转换为弧度
        x = centerX + radius * Cos(radian) ' 计算字符的x坐标
        y = centerY - radius * Sin(radian) ' 计算字符的y坐标
        Dim charHeight As Integer ' 调整y坐标以居中字符（考虑字符高度）
        charHeight = Picture1.TextHeight(Mid(text, i, 1))
        y = y - charHeight / 2
        lf.lfEscapement = (angle - 90) * 10 ' 设置字符的旋转角度
        lf.lfOrientation = (angle - 90) * 10 ' 设置字符的旋转角度
        hFont = CreateFontIndirect(lf)
        SelectObject Picture1.hdc, hFont
        Picture1.CurrentX = x ' 绘制字符X起点
        Picture1.CurrentY = y ' 绘制字符Y起点
        Picture1.Print Mid(text, i, 1)
    Next i
    SelectObject Picture1.hdc, hOldFont ' 恢复旧的字体并删除新创建的字体对象
    DeleteObject hFont
End Sub