jhone99 进来

Question

你的字体太肥胖
.lfWidth = 0.5 * intFontWidth * -20 / Screen.TwipsPerPixelX
乘了个0.5后就不对称了

Answer 1

Private Const LF_FACESIZE = 32
Private Const DEFAULT_CHARSET = 1Private 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 CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As LongPrivate 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(0 To LF_FACESIZE - 1) As Byte
End TypeConst PI = 3.1415926Private Sub Command1_Click()
    Dim BaseX As Integer, BaseY As Integer
    Dim printX As Integer
    Dim printY As Integer
    Dim printAngle As Integer
    Dim printR As Integer
    Dim sngRatio As Single
    
    BaseX = Me.Picture1.ScaleWidth / 2
    BaseY = Me.Picture1.ScaleHeight / 2
    printR = 2000
    
    For i = 0 To Len(Text1) - 1
        printX = BaseX + printR * Sin(i * 180 / Len(Text1) * PI / 180 + PI / 180 * 270 + PI / 180 * 180 / Len(Text1) / 10 * 6 * printR / 3000 * 32 / Len(Text1) / 32)
        printY = BaseY - printR * Cos(i * 180 / Len(Text1) * PI / 180 + PI / 180 * 270 + PI / 180 * 180 / Len(Text1) / 10 * 6 * printR / 3000 * 32 / Len(Text1) / 32)
        printAngle = Int(90 - i * 180 / Len(Text1) - 180 / Len(Text1) / 2 * 6 * printR / 3000 * 32 / Len(Text1) / 32)
        Call sub_RevolvePrint(printX, printY, printAngle, Mid(Text1, i + 1, 1), 6 * printR / 3000 * 32 / Len(Text1) * 2, 6 * printR / 3000 * 32 / Len(Text1))
    Next i
    
End SubPrivate Sub sub_RevolvePrint(ByVal sigCurrentX As Single, ByVal sigCurrentY As Single _
           , ByVal intAngle As Integer, ByVal strPrint As String _
           , ByVal intFontHeight As Integer, ByVal intFontWidth As Integer)
           
    Dim TFont As LOGFONT
    Dim hOldFont As Long, hFont As Long
    
    With TFont
        .lfHeight = intFontHeight * -20 / Screen.TwipsPerPixelY
        .lfWidth = intFontWidth * -20 / Screen.TwipsPerPixelX
        .lfEscapement = intAngle * 10
        .lfWeight = 700
        .lfCharSet = DEFAULT_CHARSET
    End With
    
    hFont = CreateFontIndirect(TFont)
    hOldFont = SelectObject(Me.Picture1.hdc, hFont)
    
    With Me.Picture1
        .AutoRedraw = False
'        .Cls
        .CurrentX = sigCurrentX
        .CurrentY = sigCurrentY
    End With
    
    Picture1.Print strPrint
    
    SelectObject Me.Picture1.hdc, hOldFont
    DeleteObject hFontEnd Sub
'要一个按钮一个picturebox

Answer 2

Private Const LF_FACESIZE = 32
Private Const DEFAULT_CHARSET = 1Private 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 CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As LongPrivate 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(0 To LF_FACESIZE - 1) As Byte
End TypeConst PI = 3.1415926Private Sub Command1_Click()
    Dim BaseX As Integer, BaseY As Integer
    Dim printX As Integer
    Dim printY As Integer
    Dim printAngle As Integer
    Dim printR As Integer
    Dim printR2 As Integer
    Dim printFontHeight As Integer
    Dim printFontWidth As Integer
    Dim sngRatio As Single
    
    BaseX = Me.Picture1.ScaleWidth / 2
    BaseY = Me.Picture1.ScaleHeight / 5 * 4
    printR = 5000
    printFontWidth = Int(printR * PI / 180 / Len(Text1) * 3.5)
    printFontHeight = printFontWidth * 2
    sngRatio = printFontWidth / (printR * PI / Len(Text1) / 180 * 4.5)
    printR2 = printR + printFontHeight * 20    For i = 0 To Len(Text1) - 1
        printX = BaseX + printR2 * Sin(i * 180 / Len(Text1) * PI / 180 + PI / 180 * 270 + PI / 180 * 180 / Len(Text1) * (1 - sngRatio))
        printY = BaseY - printR2 * Cos(i * 180 / Len(Text1) * PI / 180 + PI / 180 * 270 + PI / 180 * 180 / Len(Text1) * (1 - sngRatio))
        printAngle = Int(90 - i * 180 / Len(Text1) - 180 / Len(Text1) / 2 * sngRatio)
        Call sub_RevolvePrint(printX, printY, printAngle, Mid(Text1, i + 1, 1), printFontHeight, printFontWidth)
    Next i
    
End SubPrivate Sub sub_RevolvePrint(ByVal sigCurrentX As Single, ByVal sigCurrentY As Single _
           , ByVal intAngle As Integer, ByVal strPrint As String _
           , ByVal intFontHeight As Integer, ByVal intFontWidth As Integer)
           
    Dim TFont As LOGFONT
    Dim hOldFont As Long, hFont As Long
    
    With TFont
        .lfHeight = intFontHeight * 20 / Screen.TwipsPerPixelY
        .lfWidth = intFontWidth * 20 / Screen.TwipsPerPixelX
        .lfEscapement = intAngle * 10
        .lfWeight = 700
        .lfCharSet = DEFAULT_CHARSET
    End With
    
    hFont = CreateFontIndirect(TFont)
    hOldFont = SelectObject(Me.Picture1.hdc, hFont)
    
    With Me.Picture1
        .AutoRedraw = False
'        .Cls
        .CurrentX = sigCurrentX
        .CurrentY = sigCurrentY
    End With
    
    Picture1.Print strPrint
    
    SelectObject Me.Picture1.hdc, hOldFont
    DeleteObject hFontEnd Sub
'要一个按钮一个picturebox

Answer 3

Private Const LF_FACESIZE = 32
Private Const DEFAULT_CHARSET = 1Private 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 CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As LongPrivate 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(0 To LF_FACESIZE - 1) As Byte
End TypeConst PI = 3.1415926Private Sub Command1_Click()
    Dim BaseX As Integer, BaseY As Integer
    Dim printX As Integer
    Dim printY As Integer
    Dim printAngle As Integer
    Dim printR As Integer
    Dim printR2 As Integer
    Dim printFontHeight As Integer
    Dim printFontWidth As Integer
    Dim sngRatio As Single
    
    BaseX = Me.Picture1.ScaleWidth / 2
    BaseY = Me.Picture1.ScaleHeight / 5 * 4
    printR = 4000
    sngRatio = 0.7
    printFontWidth = Int(printR * PI / 180 / Len(Text1) * 4.5 * sngRatio)
    printFontHeight = printFontWidth * 2
    printR2 = printR + printFontHeight * 20    For i = 0 To Len(Text1) - 1
        printX = BaseX + printR2 * Sin(i * 180 / Len(Text1) * PI / 180 + PI / 180 * 270 + PI / 180 * 180 / Len(Text1) * (1 - sngRatio))
        printY = BaseY - printR2 * Cos(i * 180 / Len(Text1) * PI / 180 + PI / 180 * 270 + PI / 180 * 180 / Len(Text1) * (1 - sngRatio))
        printAngle = Int(90 - i * 180 / Len(Text1) - 180 / Len(Text1) / 2 * sngRatio)
        Call sub_RevolvePrint(printX, printY, printAngle, Mid(Text1, i + 1, 1), printFontHeight, printFontWidth)
    Next i
    
End SubPrivate Sub sub_RevolvePrint(ByVal sigCurrentX As Single, ByVal sigCurrentY As Single _
           , ByVal intAngle As Integer, ByVal strPrint As String _
           , ByVal intFontHeight As Integer, ByVal intFontWidth As Integer)
           
    Dim TFont As LOGFONT
    Dim hOldFont As Long, hFont As Long
    
    With TFont
        .lfHeight = intFontHeight * 20 / Screen.TwipsPerPixelY
        .lfWidth = intFontWidth * 20 / Screen.TwipsPerPixelX
        .lfEscapement = intAngle * 10
        .lfWeight = 700
        .lfCharSet = DEFAULT_CHARSET
    End With
    
    hFont = CreateFontIndirect(TFont)
    hOldFont = SelectObject(Me.Picture1.hdc, hFont)
    
    With Me.Picture1
        .AutoRedraw = False
'        .Cls
        .CurrentX = sigCurrentX
        .CurrentY = sigCurrentY
    End With
    
    Picture1.Print strPrint
    
    SelectObject Me.Picture1.hdc, hOldFont
    DeleteObject hFontEnd Sub
'要一个按钮一个picturebox

Answer 4

sngRatio = 0.3 后就不对称了
对称问题一直没解决好,得用绝对值,或者用中值与位置的差(有负值的时候)

Answer 5

Private Const LF_FACESIZE = 32
Private Const DEFAULT_CHARSET = 1Private 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 CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As LongPrivate 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(0 To LF_FACESIZE - 1) As Byte
End TypeConst PI = 3.1415926Private Sub Command1_Click()
    Dim BaseX As Integer, BaseY As Integer
    Dim printX As Integer
    Dim printY As Integer
    Dim printAngle As Integer
    Dim printR As Integer
    Dim printR2 As Integer
    Dim printFontHeight As Integer
    Dim printFontWidth As Integer
    Dim sngRatio As Single
    
    BaseX = Me.Picture1.ScaleWidth / 2
    BaseY = Me.Picture1.ScaleHeight / 5 * 4
    printR = 4000
    sngRatio = 0.3
    printFontWidth = Int(printR * PI / 180 / Len(Text1) * 4.5 * sngRatio)
    printFontHeight = printFontWidth * 2
    printR2 = printR + printFontHeight * 20    For i = 0 To Len(Text1) - 1
        printX = BaseX + printR2 * Sin(i * 180 / Len(Text1) * PI / 180 + PI / 180 * 270 + PI / 180 * 180 / Len(Text1) * (1 - sngRatio) / 2)
        printY = BaseY - printR2 * Cos(i * 180 / Len(Text1) * PI / 180 + PI / 180 * 270 + PI / 180 * 180 / Len(Text1) * (1 - sngRatio) / 2)
        printAngle = Int(90 - i * 180 / Len(Text1) - 180 / Len(Text1) * sngRatio / 2)
        Call sub_RevolvePrint(printX, printY, printAngle, Mid(Text1, i + 1, 1), printFontHeight, printFontWidth)
    Next i
    
End SubPrivate Sub sub_RevolvePrint(ByVal sigCurrentX As Single, ByVal sigCurrentY As Single _
           , ByVal intAngle As Integer, ByVal strPrint As String _
           , ByVal intFontHeight As Integer, ByVal intFontWidth As Integer)
           
    Dim TFont As LOGFONT
    Dim hOldFont As Long, hFont As Long
    
    With TFont
        .lfHeight = intFontHeight * 20 / Screen.TwipsPerPixelY
        .lfWidth = intFontWidth * 20 / Screen.TwipsPerPixelX
        .lfEscapement = intAngle * 10
        .lfWeight = 700
        .lfCharSet = DEFAULT_CHARSET
    End With
    
    hFont = CreateFontIndirect(TFont)
    hOldFont = SelectObject(Me.Picture1.hdc, hFont)
    
    With Me.Picture1
        .AutoRedraw = False
'        .Cls
        .CurrentX = sigCurrentX
        .CurrentY = sigCurrentY
    End With
    
    Picture1.Print strPrint
    
    SelectObject Me.Picture1.hdc, hOldFont
    DeleteObject hFontEnd Sub
'要一个按钮一个picturebox

Answer 6

Private Const LF_FACESIZE = 32
Private Const DEFAULT_CHARSET = 1Private 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 CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As LongPrivate 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(0 To LF_FACESIZE - 1) As Byte
End TypeConst PI = 3.1415926Private Sub Command1_Click()
    Dim BaseX As Integer, BaseY As Integer
    Dim printX As Integer
    Dim printY As Integer
    Dim printAngle As Integer
    Dim printR As Integer
    Dim printR2 As Integer
    Dim printFontHeight As Integer
    Dim printFontWidth As Integer
    Dim sngRatio As Single
    
    BaseX = Me.Picture1.ScaleWidth / 2
    BaseY = Me.Picture1.ScaleHeight / 5 * 4
    printR = 4000
    sngRatio = 0.3
    printFontWidth = Int(printR * PI / 20 / Len(Text1) * sngRatio)
    printFontHeight = printFontWidth * 2
    printR2 = printR + printFontHeight * 20    For i = 0 To Len(Text1) - 1
        printX = BaseX + printR2 * Sin(i * 180 / Len(Text1) * PI / 180 + PI / 180 * 270 + PI / 180 * 180 / Len(Text1) * (1 - sngRatio) / 2)
        printY = BaseY - printR2 * Cos(i * 180 / Len(Text1) * PI / 180 + PI / 180 * 270 + PI / 180 * 180 / Len(Text1) * (1 - sngRatio) / 2)
        printAngle = Int(90 - i * 180 / Len(Text1) - 180 / Len(Text1) / 2)
        Call sub_RevolvePrint(printX, printY, printAngle, Mid(Text1, i + 1, 1), printFontHeight, printFontWidth)
    Next i
    
End SubPrivate Sub sub_RevolvePrint(ByVal sigCurrentX As Single, ByVal sigCurrentY As Single _
           , ByVal intAngle As Integer, ByVal strPrint As String _
           , ByVal intFontHeight As Integer, ByVal intFontWidth As Integer)
           
    Dim TFont As LOGFONT
    Dim hOldFont As Long, hFont As Long
    
    With TFont
        .lfHeight = intFontHeight * 20 / Screen.TwipsPerPixelY
        .lfWidth = intFontWidth * 20 / Screen.TwipsPerPixelX
        .lfEscapement = intAngle * 10
        .lfWeight = 700
        .lfCharSet = DEFAULT_CHARSET
    End With
    
    hFont = CreateFontIndirect(TFont)
    hOldFont = SelectObject(Me.Picture1.hdc, hFont)
    
    With Me.Picture1
        .AutoRedraw = False
'        .Cls
        .CurrentX = sigCurrentX
        .CurrentY = sigCurrentY
    End With
    
    Picture1.Print strPrint
    
    SelectObject Me.Picture1.hdc, hOldFont
    DeleteObject hFontEnd Sub
'要一个按钮一个picturebox