在VB中利用Windows的API函數可以實現很多的VB無法實現的擴展功能，下面的程序介紹的是如何通過調用Windows中的API函數實現文本旋轉顯示的特級效果。
首先建立一個工程文件，然後選菜單中的Project|AddClassModule加入一個新的類文件，並將這個類的Name屬性改變為APIFont，然後在類的代碼窗口中加入以下的代碼：
OptionExplicit
PrivateDeclareFunctionSelectClipRgnLib“gdi32”(ByValhdcAsLong,ByValhRgnAsLong)AsLong
PrivateDeclareFunctionCreateRectRgnLib“gdi32”(ByValX1AsLong,ByValY1AsLong,ByValX2AsLong,ByValY2AsLong)AsLong
PrivateDeclareFunctionSetTextColorLib“gdi32”(ByValhdcAsLong,ByValcrColorAsLong)AsLong
PrivateDeclareFunctionDeleteObjectLib“gdi32”(ByValhObjectAsLong)AsLong
PrivateDeclareFunctionCreateFontIndirectLib“gdi32”Alias“CreateFontIndirectA”(lpLogFontAsLOGFONT)AsLong
PrivateDeclareFunctionSelectObjectLib“gdi32”(ByValhdcAsLong,ByValhObjectAsLong)AsLong
PrivateDeclareFunctionTextOutLib“gdi32”Alias“TextOutA”(ByValhdcAsLong,ByValXAsLong,ByValYAsLong,ByVallpStringAsString,ByValnCountAsLong)AsLong
PrivateDeclareFunctionSetTextAlignLib“gdi32”(ByValhdcAsLong,ByValwFlagsAsLong)AsLong
PrivateTypeRECT
LeftAsLong
TopAsLong
RightAsLong
BottomAsLong
EndType
PrivateConstTA_LEFT=0
PrivateConstTA_RIGHT=2
PrivateConstTA_CENTER=6
PrivateConstTA_TOP=0
PrivateConstTA_BOTTOM=8
PrivateConstTA_BASELINE=24
PrivateTypeLOGFONT
lfHeightAsLong
lfWidthAsLong
lfEscapementAsLong
lfOrientationAsLong
lfWeightAsLong
lfItalicAsByte
lfUnderlineAsByte
lfStrikeOutAsByte
lfCharSetAsByte
lfOutPrecisionAsByte
lfClipPrecisionAsByte
lfQualityAsByte
lfPitchAndFamilyAsByte
lfFaceNameAsString＊50
EndType
Privatem_LFAsLOGFONT
PrivateNewFontAsLong
PrivateOrgFontAsLong
PublicSubCharPlace(oAsObject,txt＄,X,Y)
DimThrowAsLong
DimhregionAsLong
DimRAsRECT
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)
EndSub
PublicSubSetAlign(oAsObject,Top,BaseLine,Bottom,Left,Center,Right)
DimVertAsLong
DimHorzAsLong
IfTop=TrueThenVert=TA_TOP
IfBaseLine=TrueThenVert=TA_BASELINE
IfBottom=TrueThenVert=TA_BOTTOM
IfLeft=TrueThenHorz=TA_LEFT
IfCenter=TrueThenHorz=TA_CENTER
IfRight=TrueThenHorz=TA_RIGHT
SetTextAligno.hdc,VertOrHorz
EndSub
PublicSubsetcolor(oAsObject,CvalueAsLong)
DimThrowAsLong
Throw=SetTextColor(o.hdc,Cvalue)
EndSub
PublicSubSelectOrg(oAsObject)
DimThrowAsLong
NewFont=SelectObject(o.hdc,OrgFont)
Throw=DeleteObject(NewFont)
EndSub
PublicSubSelectFont(oAsObject)
NewFont=CreateFontIndirect(m_LF)
OrgFont=SelectObject(o.hdc,NewFont)
EndSub
PublicSubFontOut(text＄,oAsControl,XX,YY)
DimThrowAsLong
Throw=TextOut(o.hdc,XX,YY,text＄,Len(text＄))
EndSub
PublicPropertyGetWidth()AsLong
Width=m_LF.lfWidth
EndProperty
PublicPropertyLetWidth(ByValWAsLong)
m_LF.lfWidth=W
EndProperty
PublicPropertyGetHeight()AsLong
Height=m_LF.lfHeight
EndProperty
PublicPropertyLetHeight(ByValvNewValueAsLong)
m_LF.lfHeight=vNewValue
EndProperty
PublicPropertyGetEscapement()AsLong
Escapement=m_LF.lfEscapement
EndProperty
PublicPropertyLetEscapement(ByValvNewValueAsLong)
m_LF.lfEscapement=vNewValue
EndProperty
PublicPropertyGetWeight()AsLong
Weight=m_LF.lfWeight
EndProperty
PublicPropertyLetWeight(ByValvNewValueAsLong)
m_LF.lfWeight=vNewValue
EndProperty
PublicPropertyGetItalic()AsByte
Italic=m_LF.lfItalic
EndProperty
PublicPropertyLetItalic(ByValvNewValueAsByte)
m_LF.lfItalic=vNewValue
EndProperty
PublicPropertyGetUnderLine()AsByte
UnderLine=m_LF.lfUnderline
EndProperty
PublicPropertyLetUnderLine(ByValvNewValueAsByte)
m_LF.lfUnderline=vNewValue
EndProperty
PublicPropertyGetStrikeOut()AsByte
StrikeOut=m_LF.lfStrikeOut
EndProperty
PublicPropertyLetStrikeOut(ByValvNewValueAsByte)
m_LF.lfStrikeOut=vNewValue
EndProperty
PublicPropertyGetFaceName()AsString
FaceName=m_LF.lfFaceName
EndProperty
PublicPropertyLetFaceName(ByValvNewValueAsString)
m_LF.lfFaceName=vNewValue
EndProperty
PrivateSubClass_Initialize()
m_LF.lfHeight=30
m_LF.lfWidth=10
m_LF.lfEscapement=0
m_LF.lfWeight=400
m_LF.lfItalic=0
m_LF.lfUnderline=0
m_LF.lfStrikeOut=0
m_LF.lfOutPrecision=0
m_LF.lfClipPrecision=0
m_LF.lfQuality=0
m_LF.lfPitchAndFamily=0
m_LF.lfCharSet=0
m_LF.lfFaceName="Arial"＋Chr(0)
EndSub
在工程文件的Form1中加入一個PictureBox和一個CommandButton控件，然後在Form1的代碼窗口中加入以下的代碼：
OptionExplicit
DimAFAsAPIFont
DimX,YAsInteger
PrivateSubCommand1_Click()
DimIAsInteger
SetAF=Nothing
SetAF=NewAPIFont
Picture2.Cls
ForI=0To3600Step360
AF.Escapement=I
AF.SelectFontPicture2
X=Picture2.ScaleWidth/2
Y=Picture2.ScaleHeight/2
'在字符串後面要加入7個空格
AF.FontOut“電腦商情報第42期”,Picture2,X,Y
AF.SelectOrgPicture2
NextI
EndSub
PrivateSubForm_Load()
Picture2.ScaleMode=3
EndSub
運行程序，點擊Form上的Command1按鈕，在窗口的圖片框就會出現旋轉的文本顯示，程序的效果如圖所示：
值得注意的問題是，由於Windows的動態連接庫的中英文版本的關系，在一些系統中顯示中文可能會有一些問題，大家可能看到，上面程序中的語句：AF.FontOut“腦商情報第42期”，Picture2,X,Y中的字符串後面有7個空格，這是對於“電腦商情報第42期”中的7個中文字符，中文系統計算的是7個字符，但是實際它們占據的是14個字節的空間，所以在輸出時要在後面添加7個空格做“替身”。上面的程序在中文Win98，VB6下運行通過。->
