SelectClipRgn
功能：选取一个区域新的剪切区域
Declare Function SelectClipRgn Lib "gdi32" Alias "SelectClipRgn" (ByVal hdc As Long, ByVal hRgn As Long) As Long
参数
hdc：设备环境句柄。
hrgn：标识被选择的区域。
返回值：返回一个剪辑区域复杂度，可以是下列值之一。
NULLREGION：区域为空；
SIMPLEREGION：区域为单个矩形；
COMPLEXREGION：区域为多个矩形；
ERROR：发生错误（以前的剪切区域不受影响）。
CreateRectRgn
创建一个由点X1，Y1和X2，Y2描述的矩形区域
Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
参数
X1,Y1 Long，矩形左上角X，Y坐标
X2,Y2 Long，矩形右下角X，Y坐标
返回值
执行成功为区域句柄，失败则为零
SetTextAlign
该函数为指定设备环境设置文字对齐
Declare Function SetTextAlign Lib "gdi32" Alias "SetTextAlign" (ByVal hdc As Long, ByVal wFlags As Long) As Long
参数
HDC hdc, // 设备环境句柄
UINT fMode // 文本对齐选项
TA_BASELINE
基准点在正文的基线上。
TA_BOTTOM
基准点在限定矩形的下边界上。
TA_TOP
基准点在限定矩形的上边界上。
TA_CENTER
基准点与限定矩形的中心水平对齐。
TA_LEFT
基准点在限定矩形的左边界上。
TA_RIGHT
基准点在限定矩形的右边界上。
TA_RTLREADING
对于中东Windows版，正文从右到左的阅读顺序排列，与缺省的从左到右正好相反。
只有当被选择的字体是Hebrew或Arabic时，此值才有用。
TA_NOUPDATECP
每次文字输出调用后当前基准点不改变。基准点是传输给正文输出函数的位置。
TA_UPDATECP
每次文字输出调用后当前基准点改变。当前位置作为基准点。
若当前字体有一条缺省的垂直基线（如Kanji），下列值用于取代TA_BASELINE和TA_CENTER，各值含义为：
VTA_BASELINE
基准点在正文的基线上。
VTA_CENTER
基准点与限定矩形的中心垂直对齐。
缺省值是TA_LEFT, TA_TOP和TA_NOUPDATECP。
如果函数调用成功，返回值是文字对齐方式的前一个设置；
如果函数调用失败，返回值是GDI_ERROR
文本应用示例
Option ExplicitPrivate Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As LongPrivate Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As LongPrivate Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As LongPrivate Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As LongPrivate Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As LongPrivate Declare Function SetTextAlign Lib "gdi32" (ByVal hdc As Long, ByVal wFlags As Long) As LongPrivate 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 LongPrivate Type RECTLeft As LongTop As LongRight As LongBottom As LongEnd Type Private Const TA_LEFT = 0 Private Const TA_RIGHT = 2 Private Const TA_CENTER = 6 Private Const TA_TOP = 0 Private Const TA_BOTTOM = 8 Private Const TA_BASELINE = 24Private Type LOGFONTlfHeight As LonglfWidth As LonglfEscapement As LonglfOrientation As LonglfWeight As LonglfItalic As BytelfUnderline As BytelfStrikeOut As BytelfCharSet As BytelfOutPrecision As BytelfClipPrecision As BytelfQuality As BytelfPitchAndFamily As BytelfFaceName As String * 50End TypePrivate m_LF As LOGFONTPrivate NewFont As LongPrivate OrgFont As LongPublic Sub CharPlace(o As Object, txt, x, y)Dim Throw As LongDim hregion As LongDim R As RECTR.Left = x R.Right = x + o.TextWidth(txt) * 2R.Top = yR.Bottom = y + o.TextHeight(txt) * 2hregion = 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 SubPublic Sub SetAlign(o As Object, Top, BaseLine, Bottom, Left, Center, Right)Dim Vert As LongDim Horz As LongIf Top = True Then Vert = TA_TOPIf BaseLine = True Then Vert = TA_BASELINEIf Bottom = True Then Vert = TA_BOTTOMIf Left = True Then Horz = TA_LEFTIf Center = True Then Horz = TA_CENTERIf Right = True Then Horz = TA_RIGHTSetTextAlign o.hdc, Vert Or HorzEnd Sub Public Sub setcolor(o As Object, CValue As Long)Dim Throw As LongThrow = SetTextColor(o.hdc, CValue)End SubPublic Sub SelectOrg(o As Object)Dim Throw As LongNewFont = SelectObject(o.hdc, OrgFont)Throw = DeleteObject(NewFont)End SubPublic 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 LongThrow = TextOut(o.hdc, XX, YY, text, Len(text))End SubPublic Property Get Width() As LongWidth = m_LF.lfWidthEnd Property Public Property Let Width(ByVal W As Long)m_LF.lfWidth = WEnd PropertyPublic Property Get Height() As LongHeight = m_LF.lfHeightEnd Property Public Property Let Height(ByVal vNewValue As Long)m_LF.lfHeight = vNewValueEnd PropertyPublic Property Get Escapement() As LongEscapement = m_LF.lfEscapementEnd Property Public Property Let Escapement(ByVal vNewValue As Long)m_LF.lfEscapement = vNewValueEnd PropertyPublic Property Get Weight() As LongWeight = m_LF.lfWeightEnd Property Public Property Let Weight(ByVal vNewValue As Long)m_LF.lfWeight = vNewValueEnd PropertyPublic Property Get Italic() As ByteItalic = m_LF.lfItalicEnd Property Public Property Let Italic(ByVal vNewValue As Byte)m_LF.lfItalic = vNewValueEnd PropertyPublic Property Get UnderLine() As ByteUnderLine = m_LF.lfUnderlineEnd Property Public Property Let UnderLine(ByVal vNewValue As Byte)m_LF.lfUnderline = vNewValueEnd PropertyPublic Property Get StrikeOut() As ByteStrikeOut = m_LF.lfStrikeOutEnd Property Public Property Let StrikeOut(ByVal vNewValue As Byte)m_LF.lfStrikeOut = vNewValueEnd PropertyPublic Property Get FaceName() As StringFaceName = m_LF.lfFaceNameEnd Property Public Property Let FaceName(ByVal vNewValue As String)m_LF.lfFaceName = vNewValueEnd PropertyPrivate Sub Class_Initialize()m_LF.lfHeight = 15m_LF.lfWidth = 15m_LF.lfEscapement = 0m_LF.lfWeight = 400m_LF.lfItalic = 0m_LF.lfUnderline = 0m_LF.lfStrikeOut = 0m_LF.lfOutPrecision = 0m_LF.lfClipPrecision = 0m_LF.lfQuality = 0m_LF.lfPitchAndFamily = 0m_LF.lfCharSet = 0m_LF.lfFaceName = "Arial" + Chr(0)End Sub
消息响应函数
Option ExplicitDim af As APIFontDim x, y As IntegerPrivate Sub cmdAngle_Click()Dim i As IntegerSet af = NothingSet af = New APIFontPicture1.Cls For i = 0 To 3600 Step 90af.Escapement = iaf.SelectFont Picture1x = Picture1.ScaleWidth / 2y = Picture1.ScaleHeight / 2af.FontOut "Comrade Studio", Picture1, x, yaf.SelectOrg Picture1Next iEnd SubPrivate Sub cmdHeight_Click() Dim i As IntegerSet af = NothingSet af = New APIFontPicture1.Cls For i = 0 To 360 Step 1Picture1.Clsaf.Height = iaf.SelectFont Picture1x = Picture1.ScaleWidth / 2y = Picture1.ScaleHeight / 2af.FontOut "Comrade Studio", Picture1, x, yaf.SelectOrg Picture1Next iEnd SubPrivate Sub cmdWeight_Click()Dim i As Integeri = 0Set af = NothingSet af = New APIFontPicture1.Cls For i = 0 To 3600 Step 1Picture1.Clsaf.Weight = i * 5af.SelectFont Picture1x = Picture1.ScaleWidth / 2y = Picture1.ScaleHeight / 2af.FontOut "Comrade Studio", Picture1, x, yaf.SelectOrg Picture1Next iEnd SubPrivate Sub cmdWidth_Click()Dim i As IntegerSet af = NothingSet af = New APIFontPicture1.Cls For i = 0 To 360 Step 1Picture1.Clsaf.Width = iaf.SelectFont Picture1x = Picture1.ScaleWidth / 2y = Picture1.ScaleHeight / 2'在字符串后面要加入5个空格af.FontOut "同志工作室 ", Picture1, x, yaf.SelectOrg Picture1Next iEnd SubPrivate Sub Form_Load()Picture1.ScaleMode = 3End Sub
运行结果如图：
