首先建立一个工程文件，然后选菜单中的Project
| Add Class Module 加入一个新的类文件，并将这个类的Name属性改变为APIFont，然后在类的代码窗口中加入以下的代码：
Option Explicit
Private Declare Function
SelectClipRgn Lib “gdi32”(ByVal hdc As Long, ByVal hRgn As Long) As
Long Private Declare Function CreateRectRgn Lib “gdi32”(ByVal X1 As
Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As
Long Private Declare Function SetTextColor Lib “gdi32”(ByVal hdc As
Long, ByVal crColor 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 Long Private Declare
Function SelectObject Lib “gdi32”(ByVal hdc As Long, ByVal hObject 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 SetTextAlign Lib “gdi32”(ByVal hdc As Long, ByVal wFlags As Long)
As Long
Private Type RECT Left As Long Top As
Long Right As Long Bottom As Long End
Type
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 ＊ 50 End Type
Private m_LF
As LOGFONT Private NewFont As Long Private OrgFont As
Long Public Sub CharPlace(o As Object, txt＄, X, Y) Dim Throw As
Long Dim hregion As Long Dim R As RECT
R.Left =
X R.Right = X ＋ o.TextWidth(txt＄) ＊ 2 R.Top = Y R.Bottom
= Y ＋ o.TextHeight(txt＄) ＊ 2
hregion = CreateRectRgn(R.Left,
R.Top, R.Right, R.Bottom) Throw = SelectClipRgn(o.hdc,
hregion) Throw = TextOut(o.hdc, X, Y, txt＄, Len(txt＄))
DeleteObject (hregion) End Sub Public Sub SetAlign(o As Object,
Top, BaseLine, Bottom, Left, Center, Right) Dim Vert As Long
Dim Horz As Long
If Top = True Then Vert = TA_TOP If
BaseLine = True Then Vert = TA_BASELINE If Bottom = True Then Vert =
TA_BOTTOM If Left = True Then Horz = TA_LEFT If Center = True
Then Horz = TA_CENTER If Right = True Then Horz = TA_RIGHT
SetTextAlign o.hdc, Vert Or Horz End Sub Public Sub setcolor(o
As Object, Cvalue As Long) Dim Throw As Long
Throw =
SetTextColor(o.hdc, Cvalue) End Sub Public Sub SelectOrg(o As
Object) Dim Throw As Long
NewFont = SelectObject(o.hdc,
OrgFont) Throw = DeleteObject(NewFont) End Sub Public Sub
SelectFont(o As Object) NewFont = CreateFontIndirect(m_LF)
OrgFont = SelectObject(o.hdc, NewFont) End Sub Public Sub
FontOut(text＄, o As Control, XX, YY) Dim Throw As Long
Throw = TextOut(o.hdc, XX, YY, text＄, Len(text＄)) End
Sub
Public Property Get Width() As Long Width =
m_LF.lfWidth End Property
Public Property Let Width(ByVal
W As Long) m_LF.lfWidth = W End Property
Public
Property Get Height() As Long Height = m_LF.lfHeight End
Property
Public Property Let Height(ByVal vNewValue As
Long) m_LF.lfHeight = vNewValue End Property
Public
Property Get Escapement() As Long Escapement =
m_LF.lfEscapement End Property
Public Property Let
Escapement(ByVal vNewValue As Long) m_LF.lfEscapement =
vNewValue End Property
Public Property Get Weight() As
Long Weight = m_LF.lfWeight End Property
Public
Property Let Weight(ByVal vNewValue As Long) m_LF.lfWeight =
vNewValue End Property
Public Property Get Italic() As
Byte Italic = m_LF.lfItalic End Property
Public
Property Let Italic(ByVal vNewValue As Byte) m_LF.lfItalic =
vNewValue End Property
Public Property Get UnderLine() As
Byte UnderLine = m_LF.lfUnderline End
Property
Public Property Let UnderLine(ByVal vNewValue As
Byte) m_LF.lfUnderline = vNewValue End
Property
Public Property Get StrikeOut() As Byte
StrikeOut = m_LF.lfStrikeOut End Property
Public Property
Let StrikeOut(ByVal vNewValue As Byte) m_LF.lfStrikeOut =
vNewValue End Property
Public Property Get FaceName() As
String FaceName = m_LF.lfFaceName End
Property
Public Property Let FaceName(ByVal vNewValue As
String) m_LF.lfFaceName = vNewValue End
Property
Set AF = Nothing
Set AF = New APIFont Picture2.Cls For I = 0 To 3600
Step 360 AF.Escapement = I AF.SelectFont Picture2 X =
Picture2.ScaleWidth / 2 Y = Picture2.ScaleHeight /
2 在字符串后面要加入7个空格
AF.FontOut “电脑商情报第42期 ”, Picture2, X, Y
AF.SelectOrg Picture2 Next I End Sub
Private Sub
Form_Load() Picture2.ScaleMode = 3 End Sub
运行程序，点击Form上的Command1按钮，在窗口的图片框就会出现旋转的文本显示，程序的效果如图所示：
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
