#If Win32 Then
Private Type LOGFONT_TYPE
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 Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT_TYPE) As Long
#Else
Private Type LOGFONT_TYPE
lfHeight As Integer
lfWidth As Integer
lfEscapement As Integer
lfOrientation As Integer
lfWeight As Integer
lfItalic As String * 1
lfUnderline As String * 1
lfStrikeOut As String * 1
lfCharSet As String * 1
lfOutPrecision As String * 1
lfClipPrecision As String * 1
lfQuality As String * 1
lfPitchAndFamily As String * 1
lffacename As String * 32
End Type
Private Declare Function CreateFontIndirect Lib "GDI" (lpLogFont As Any) As Integer
#End If
#If Win32 Then
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
#Else
Private Declare Function SelectObject Lib "GDI" (ByVal hdc As Integer, ByVal hObject As Integer) As Integer
Private Declare Function DeleteObject Lib "GDI" (ByVal hObject As Integer) As Integer
#End If
Private Sub TextCircle(obj As Object, txt As String, X As Long, Y As Long, radius As Long, startdegree As Double)
Dim foo As Integer, TxtX As Long, TxtY As Long, checkit As Integer
Dim twipsperdegree As Long, wrktxt As String, wrklet As String, degreexy As Double, degree As Double
twipsperdegree = (radius * 3.14159 * 2) / 360
If startdegree < 0 Then
Select Case startdegree
Case -1
startdegree = Int(360 - (((obj.TextWidth(txt)) / twipsperdegree) / 2))
Case -2
radius = (obj.TextWidth(txt) / 2) / 3.14159
twipsperdegree = (radius * 3.14159 * 2) / 360
End Select
End If
For foo = 1 To Len(txt)
wrklet = Mid$(txt, foo, 1)
degreexy = (obj.TextWidth(wrktxt)) / twipsperdegree + startdegree
DegreesToXY X, Y, degreexy, radius, radius, TxtX, TxtY
degree = (obj.TextWidth(wrktxt) + 0.5 * obj.TextWidth(wrklet)) / twipsperdegree + startdegree
RotateText 360 - degree, obj, obj.fontname, obj.Fontsize, (TxtX), (TxtY), wrklet
wrktxt = wrktxt & wrklet
Next foo
End Sub
Private Sub DegreesToXY(CenterX As Long, CenterY As Long, degree As Double, radiusX As Long, radiusY As Long, X As Long, Y As Long)
Dim convert As Double
Private Sub RotateText(Degrees As Integer, obj As Object, fontname As String, Fontsize As Single, X As Integer, Y As Integer, Caption As String)
Dim RotateFont As LOGFONT_TYPE
Dim CurFont As Long, rFont As Long, foo As Long
RotateFont.lfEscapement = Degrees * 10
RotateFont.lffacename = fontname & Chr$(0)
If obj.FontBold Then
RotateFont.lfWeight = 800
Else
RotateFont.lfWeight = 400
End If
RotateFont.lfHeight = (Fontsize * -20) / Screen.TwipsPerPixelY
rFont = CreateFontIndirect(RotateFont)
CurFont = SelectObject(obj.hdc, rFont)
obj.CurrentX = X
obj.CurrentY = Y
obj.Print Caption
楼主要的是这种效果吧
Function reversestring(revstr As String) As String
' revstr: 要翻转的字符串
' 返回值:翻转后的字符串
Dim doreverse As Long
reversestring = ""
For doreverse = Len(revstr) To 1 Step -1
reversestring = reversestring & Mid$(revstr, doreverse, 1)
Next
End Function