VB与API学习笔记(8)GDI对象

89 阅读 0 评论 59 点赞

我是靠谱客的博主诚心樱桃，最近开发中收集的这篇文章主要介绍VB与API学习笔记(8)GDI对象，觉得挺不错的，现在分享给大家，希望可以做个参考。

概述

回顾：1、DC就是我们所说DC，在DC上画会即时在窗体上画出。它就象一个画布，我们操作它也即时发生变化，别人操作它也即时发生变化。

缺点：如果被挡住，或最小化后，所画的东西就消失了。“别人”操作就是被其它窗体挡住。

2、后台DC，相当于备份DC。只有内存DC复制到前台DC才会即时显示，否则，起不了作用。所以后台DC一般用于备份。当恢复窗体时，

内存DC就起到了作用，复制到前台DC，窗体中图形就恢复了。

3、无论何种DC，它只是一个画布，一个被别人任意“蹂躏”的画面。它还需要其它东西才能成一个画面，比如用笔（Pen)来画线（包括线的粗细，

线的宽度等），Brush来涂抹(怎么涂，涂什么）。所以我们需要指定，前面很多没有指定，是因为用了“默认”的Pen,Brush等。只有Bitmap用到

指定，指定了图的大小，色位等。这个指定就是选择对象。SelectObject

可以发现一个奇妙处，返回值都是以前的对象，这是便于恢复以前的对象。

例对笔刷的操作：

hOldBrush=SelectObject(hDC,hBrush)

上面的对象Pen,Brush,Bitmap等就是GDI对象。

一、笔

Private Declare Function CreatePen _
                Lib "gdi32" (ByVal nPenStyle As Long, _
                             ByVal nWidth As Long, _
                             ByVal crColor As Long) As Long

建立笔对象：返回值0失败，非0成功

nPenStyle 画笔样式

vbSolid 0 实线

vbDash 1 破折线

vbDot 2 点线

vbDashDot 3 破折-点线

vbDashDotDot 4 破折-点-点线

vbInvisible 5 透明

vbInsideSolid 6 内实线

nWidth 画笔线宽（0为单点）

crColor 线色

二、实心笔刷

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

crColor 实心笔刷的颜色。

hBrush=CreateSolidBrush(RGB(255,0,0))

点线蓝色外框，背景涂红的矩形：

上面建立了花色笔刷PatternBrush,实际上就是由较小的Bitmap组成

Private Declare Function CreatePatternBrush Lib "gdi32" Alias "CreatePatternBrush" (ByVal hBitmap As Long) As Long

除了花色笔刷、实心笔刷，下面一个条纹笔刷
Private Declare Function CreateHatchBrush Lib "gdi32" Alias "CreateHatchBrush" (ByVal nIndex As Long, ByVal crColor As Long) As Long

nIndex: 条纹笔刷样式

HS_Horizontal=0 水平线

HS_Vertical=1 垂直线

HS_Fdiagonal=2 左上到右下斜线，diagonal斜线

HS_Bdiagonal=3 左下到右上斜线

HS_Cross=4 垂直交叉线

HS_DiagCross=5 对角交叉线

crColor 笔刷颜色

Private Sub Command1_Click()
    Dim hPen    As Long, hBrush As Long
    Dim hOldPen As Long, hOldBrush As Long

    hPen = CreatePen(vbDashDot, 1, vbBlue)
    hBrush = CreateHatchBrush(HS_DIAGCROSS, vbRed)
    hOldPen = SelectObject(Me.hdc, hPen)
    hOldBrush = SelectObject(Me.hdc, hBrush)
    Rectangle Me.hdc, 10, 10, 200, 100
    DeleteObject hOldPen
    DeleteObject hOldBrush
End Sub

Bezier 贝赛尔曲线

lppt: 数组传入地址，由第一元素代替

cPoints 传入点数。至少4点，如图，1，4表示起始与终止点，2，3决定曲线弯曲情况。每次递增3个点。

故总点数应为：3*N+1个

注意最后参数是传址，省略会发生错误，因为会被认为是传递是地址4处的值。

回顾：画多边形：Polygon

Private Declare Function Polygon _
Lib "gdi32" (ByVal hdc As Long, _
lpPoint As POINTAPI, _
ByVal nCount As Long) As Long

这里面点的顺序会造成图的交错，如果用笔刷时就会有交错地方

Private Declare Function SetPolyFillMode _
Lib "gdi32" (ByVal hdc As Long, _
ByVal nPolyFillMode As Long) As Long

Alternate=1 不涂抹交错区域

Winding=2 涂抹交错区域（全涂）

Private Declare Function Polygon _
                Lib "gdi32" (ByVal hdc As Long, _
                             lpPoint As POINTAPI, _
                             ByVal nCount As Long) As Long

Private Declare Function SetPolyFillMode _
                Lib "gdi32" (ByVal hdc As Long, _
                             ByVal nPolyFillMode As Long) As Long

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject _
                Lib "gdi32" (ByVal hdc As Long, _
                             ByVal hObject As Long) As Long

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Const ALTERNATE = 1
Private Const WINDING = 2

Private Sub Command1_Click()
    Dim p(4)   As POINTAPI
    Dim hBrush As Long, hOldBrush As Long, hOldFillMode As Long

    p(0).x = 0
    p(0).y = 100
    p(1).x = 300
    p(1).y = 100
    p(2).x = 100
    p(2).y = 200
    p(3).x = 100
    p(3).y = 10
    p(4).x = 200
    p(4).y = 200
    hBrush = CreateSolidBrush(RGB(255, 0, 0))
    hOldBrush = SelectObject(Me.hdc, hBrush)
    hOldFillMode = SetPolyFillMode(Me.hdc, ALTERNATE)
    Polygon Me.hdc, p(0), ByVal 5&
    SetPolyFillMode Me.hdc, hOldFillMode '恢复原填充模式
    DeleteObject hOldBrush '删除原笔刷
End Sub

填充颜色：FloodFill

就象发怒似地把一桶全倒出来，只有有围栏（边框)的才能被拦住。

即把颜色填充到一个指定的区域

Private Declare Function FloodFill _
Lib "gdi32" (ByVal hdc As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal crColor As Long) As Long

（x,y) 是指定区域内的任意一点

crColor 指定区域内边框的颜色。

注意，这个填充色并不在这个API中，它只是指明了范围。颜色在笔刷中需笔刷API来指定。

同时，这个API是一个“动作”，只有边框确定后，再执行这个动作，才能正确的填充

回顾：矩形Rectangle

Private Declare Function Rectangle _
Lib "gdi32" (ByVal hdc As Long, _
ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 As Long) As Long

再看：圆角矩形 RoundRect

Private Declare Function RoundRect _
Lib "gdi32" (ByVal hdc As Long, _
ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 As Long, _
ByVal X3 As Long, _
ByVal Y3 As Long) As Long

多了最后一个（X3，Y3)，这不是一个点的坐标，而是一个椭圆的实际宽、高，用它来确定圆角的“程度”

下面，确定笔刷后，画区域，再倒颜色。

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
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
Private Declare Function RoundRect _
                Lib "gdi32" (ByVal hdc As Long, _
                             ByVal X1 As Long, _
                             ByVal Y1 As Long, _
                             ByVal X2 As Long, _
                             ByVal Y2 As Long, _
                             ByVal X3 As Long, _
                             ByVal Y3 As Long) As Long

Private Declare Function FloodFill _
                Lib "gdi32" (ByVal hdc As Long, _
                             ByVal x As Long, _
                             ByVal y As Long, _
                             ByVal crColor As Long) As Long

Private Declare Function CreatePen _
                Lib "gdi32" (ByVal nPenStyle As Long, _
                             ByVal nWidth As Long, _
                             ByVal crColor As Long) As Long

Private Const PS_SOLID = 0

Private Sub Command1_Click()
    Dim hBrush As Long, hOldBrush As Long
    Dim hPen   As Long, hOldPen As Long

    hPen = CreatePen(PS_SOLID, 1, RGB(0, 0, 0))
    hOldPen = SelectObject(Me.hdc, hPen)
    hBrush = CreateSolidBrush(RGB(255, 0, 0))
    hOldBrush = SelectObject(Me.hdc, hBrush) '选择实心笔刷
    RoundRect Me.hdc, 10, 10, 200, 150, 100, 50  '这句须在下句前，先画一个区域（圆形矩形）
    FloodFill Me.hdc, 60, 60, RGB(0, 0, 0)   '指定范围填充，这句：然后对某点倒颜色。
    SelectObject Me.hdc, hOldBrush  '恢复
    SelectObject Me.hdc, hOldPen
    DeleteObject hPen '删除
    DeleteObject hBrush
End Sub

====================================

(一）判断点是否在一条线段上

回调函数：CallBack

一般调用函数是在主程序中A处，调用B函数。但有时不想改变已经成型的B模块，想加入自己的一些功能。

比如，调用B文件返回的是一组数组，但这次我想它返回“已经排好序”的数组。这个排序可能是从大到小，

也可能是由小到大，等等，实现的排序的方法又各自不同。这都是用户自己来决定。

这时已经编好的模块B就没法完成这样的功能。我们又不想破坏它的（多人编程，大家都知道B是不变的）

于是，在调用B函数时，我们传一个函数C的地址，C完成我们自定的排序及排序方法。这个地址便于B函数

再次传回来调用C程序，达到完成自己定义方式的调用。

整个过程就是：A处调用B，B回调用lpFun即调用C。

相当于我打了你一拳，你回打了我一拳。

==========================================================================

判断一个点是不是在一条线段上，用数学的方法比较直接直观，但不高效。
用API，直接枚举线段上各点，再判断该点是否在枚举中，比较快。
枚举线段各点：LineDDA
Declare Function LineDDA _
Lib "gdi32" (ByVal n1 As Long, _
ByVal n2 As Long, _
ByVal n3 As Long, _
ByVal n4 As Long, _
ByVal lpLineDDAProc As Long, _
ByVal lParam As Long) As Long
(n1,n2) 线段起点
(n3,4) 线段终点
lpLineDDAProc 回调函数。返回线段上各点，自定义处理
IParam 回调函数参数不够时，用这个补充。无补充时用0

因此我们须自定义回调函数，因为这个要用到函数地址，须在模块中（否则，过程模块的Addressof会出错）。添加模块定义如下：

Option Explicit
Declare Function LineDDA _
        Lib "gdi32" (ByVal n1 As Long, _
                     ByVal n2 As Long, _
                     ByVal n3 As Long, _
                     ByVal n4 As Long, _
                     ByVal lpLineDDAProc As Long, _
                     ByVal lParam As Long) As Long

Public px(2048) As Long
Public py(2048) As Long
Public npoint   As Long

Sub LineDDAProc(ByVal X As Long, ByVal Y As Long, ByVal lpData As Long)

    px(npoint) = X
    py(npoint) = Y
    npoint = npoint + 1
End Sub

过程模块：

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim i As Long

    npoint = 0
    LineDDA 20, 20, 200, 200, AddressOf LineDDAProc, 0  '枚举线段上每一个点

    For i = 0 To npoint - 1    '对比各点是否与点击处相等，相等，说明该点在线上

        If X = px(i) And Y = py(i) Then
            MsgBox "OK"
        End If
    Next
End Sub

Private Sub Form_Paint()
    Me.ScaleMode = vbPixels
    Line (20, 20)-(200, 200)
End Sub

=================================================

（二）判断点是否在一个区域内

应用：是否在某行政区域地图中；创建不规则按钮时，当在其内时显示不同的效果

PtInRegion ： Point In Region

Private Declare Function PtInRegion _
Lib "gdi32" (ByVal hRgn As Long, _
ByVal x As Long, _
ByVal y As Long) As Long

hRgn: Handle of Region 区域句柄。需要建立和取得

（x,y) ：点的位置

返回值：（x,y)在区域hRgn内，为真，值不为0；否则为假为0

建立区域和返回区域句柄：

CreateRectRgn 建立矩形区域，并传回hRegion

CreateRoundRectRgn 建立圆角矩形区域，并传回hRegion

CreateEllipiseRgn 建立圆形（椭圆）区域，并传回hRegion

CreatePolygonRgn 建立多边开区域，并传回hRegion

具体看一下：

1、CreateRectRgn

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 Rectangle _
Lib "gdi32" (ByVal hdc As Long, _
ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 As Long) As Long

只是少了一个hdc。

2、CreateRoundRectRgn

Private Declare Function CreateRoundRectRgn _
Lib "gdi32" (ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 As Long, _
ByVal X3 As Long, _
ByVal Y3 As Long) As Long

同样对比一下建立圆角矩形“图形”的API

Private Declare Function RoundRect _
Lib "gdi32" (ByVal hdc As Long, _
ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 As Long, _
ByVal X3 As Long, _
ByVal Y3 As Long) As Long

也是少了一个hdc,圆角处都是（x3,y3)来控制

3、CreateEllipiseRgn
Private Declare Function CreateEllipticRgn _
Lib "gdi32" (ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 As Long) As Long

对比Ellipise

Private Declare Function Ellipse _
Lib "gdi32" (ByVal hdc As Long, _
ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 As Long) As Long

嗯，仍少了hdc

4、CreatePolygonRgn
Private Declare Function CreatePolygonRgn _
Lib "gdi32" (lpPoint As POINTAPI, _
ByVal nCount As Long, _
ByVal nPolyFillMode As Long) As Long

对比Polygon

Private Declare Function Polygon _
Lib "gdi32" (ByVal hdc As Long, _
lpPoint As POINTAPI, _
ByVal nCount As Long) As Long

噫，有点花样，除了少了hdc外，还多了一个nPolyFillMode

实际上并没有啥新的，nPolyFillMode就是SetPolyFillMode中的填充模式，

Alternate=1 不涂抹交错区域

Winding=2 涂抹交错区域（全涂）

上面建立成功后，返回区域句柄hRegion；否则返回0值

Option Explicit

Private Declare Function PtInRegion _
                Lib "gdi32" (ByVal hRgn As Long, _
                             ByVal X As Long, _
                             ByVal Y As Long) As Long

Private Declare Function CreateEllipticRgn _
                Lib "gdi32" (ByVal X1 As Long, _
                             ByVal Y1 As Long, _
                             ByVal X2 As Long, _
                             ByVal Y2 As Long) As Long

Private Declare Function Ellipse _
                Lib "gdi32" (ByVal hdc As Long, _
                             ByVal X1 As Long, _
                             ByVal Y1 As Long, _
                             ByVal X2 As Long, _
                             ByVal Y2 As Long) As Long

Private Declare Function CreatePolygonRgn _
                Lib "gdi32" (lpPoint As POINTAPI, _
                             ByVal nCount As Long, _
                             ByVal nPolyFillMode As Long) As Long

Private Declare Function Polygon _
                Lib "gdi32" (ByVal hdc As Long, _
                             lpPoint As POINTAPI, _
                             ByVal nCount As Long) As Long

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
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

Private Const ALTERNATE = 1
Private Const WINDING = 2

Private Type POINTAPI
    X As Long
    Y As Long
End Type
Dim p(4)     As POINTAPI
Dim hPolyRgn As Long

Private Sub Command1_Click()
    Dim hBrush As Long, hOldBrush As Long

    hBrush = CreateSolidBrush(vbRed)
    hOldBrush = SelectObject(Me.hdc, hBrush)
    Polygon Me.hdc, p(0), ByVal 5&
    hPolyRgn = CreatePolygonRgn(p(0), ByVal 5&, ALTERNATE)
    SelectObject Me.hdc, hOldBrush
    DeleteObject hBrush
End Sub

Private Sub Form_Load()
    p(0).X = 10
    p(0).Y = 100
    p(2).X = 100
    p(2).Y = 10
    p(4).X = 200
    p(4).Y = 100
    p(1).X = 150
    p(1).Y = 200
    p(3).X = 50
    p(3).Y = 200
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Me.ScaleMode = vbPixels '改变X，Y为像素

    If PtInRegion(hPolyRgn, X, Y) Then
        MsgBox "在内"
    Else
        MsgBox "不在其中"
    End If
End Sub

如果一个区域表示一个集合，另一个区域也表示一个集合。

那么两个区域之间就会产生：交集、并集、Xor集，差集

这些行会都会因组合方式的不同而成为新的实心部分，形成另一个新的区域

CombineRgn 组合形成新区域

Private Declare Function CombineRgn _
Lib "gdi32" (ByVal hDestRgn As Long, _
ByVal hSrcRgn1 As Long, _
ByVal hSrcRgn2 As Long, _
ByVal nCombineMode As Long) As Long

hDestRgn 目的区域（最后形成的新区域）。这个必须先存在（可建立一个“空”区域，目的是获取句柄）。D

hSrcRgn 来源区域一。S1

hSrcRgn 来源区域二。S2

nCombineMode 组合方式：

Rgn_And=1 D=S1 And S2

Rgn_Or=2 D=S1 Or S2

Rgn_Xor=3 D=S1 Xor S2

Rgn_Diff=4 D=S1 - S2

Rgn_Copy=5 D=S1

返回值：0失败，非0成功即：

NullRegion=1 空集（没有交集的求交集

SimplerRegion=2 单一区域（组合后，只有一“块”区域）

ComplexRegion=3 复杂区域（多块区域，有多块区域组成一个集合）

==========================================================================

文字的输出

文字也作为GDI绘图的对象，如同笔刷一样。

Private Declare Function CreateFontIndirect _
                Lib "gdi32" _
                Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long

'字型结构
Private Type LOGFONT
    lfHeight As Long   '与VB转换，字型高度=（Font.Size*20)/Screen.TwipPerPixelY
    lfWidth As Long    '字宽，常设置0，与高度的比例值===========等号为效果常用
    lfEscapement As Long   '旋转角度，1/10度为一单位。90度设置数值900。=========.
    lfOrientation As Long  '每个字符的旋转角度。
    lfWeight As Long       '字体粗细，400正常，700粗体
    lfItalic As Byte       '斜体。0正常，非0斜体
    lfUnderline As Byte    '下划线。0正常，非0加下划线
    lfStrikeOut As Byte    '删除线。0正常，非0加删除线
    lfCharSet As Byte      '字符集。Default_Charset=1,由windows来决定；0英文字型
    lfOutPrecision As Byte  '输出精准度，0，由windows自行决定
    lfClipPrecision As Byte  '描绘区边缘的准确度，0，由windows自行决定
    lfQuality As Byte        '输出品质，0，由windows自行决定
    lfPitchAndFamily As Byte   '是否为等宽字体。无作用，常由下面字型名参数决定
    lfFaceName(1 To LF_FACESIZE) As Byte '字型名字。
End Type

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
Private Declare Sub RtlMoveMemory _
                Lib "KERNEL32" (lpvDest As Any, _
                                lpvSource As Any, _
                                ByVal cbCopy As Long)

Private Const LF_FACESIZE = 32
Private Const DEFAULT_CHARSET = 1

Private Sub Command1_Click()
    Dim font     As LOGFONT
    Dim hOldFont As Long, hFont As Long

    '字符转到字节数组中
    RtlMoveMemory font.lfFaceName(1), ByVal CStr(cmbFontName), LenB(StrConv(cmbFontName, vbFromUnicode)) + 1
    '字体各属性设置
    font.lfHeight = (Val(txtHeight) * -20) / Screen.TwipsPerPixelY '高度
    font.lfWidth = (Val(txtWidth) * -20) / Screen.TwipsPerPixelY  '宽度
    font.lfEscapement = Val(txtRotate) * 10 '旋转角度
    font.lfWeight = IIf(chkBold, 700, 400)  '粗体
    font.lfItalic = chkItalic '斜体
    font.lfUnderline = chkUnderline '下划线
    font.lfStrikeOut = chkStrikeThrough '删除线
    font.lfCharSet = DEFAULT_CHARSET
    '创建字体对象并选用
    hFont = CreateFontIndirect(font)
    hOldFont = SelectObject(Picture1.hDC, hFont)
    Picture1.Cls
    '定位
    Picture1.CurrentX = Picture1.ScaleWidth / 2
    Picture1.CurrentY = Picture1.ScaleHeight / 2
    Picture1.Print txtString.Text
    SelectObject Picture1.hDC, hOldFont
    DeleteObject hFont
End Sub

Private Sub Form_Load()
    Dim i As Integer

    For i = 0 To Screen.FontCount - 1
        cmbFontName.AddItem Screen.Fonts(i) '加入本机字体
    Next
    cmbFontName.Text = "Times New Roman"
End Sub

----------------------------------------------

输出文字：TextOut

类似Print功能

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
'nCount字串的长度，以字节计算
Private Sub Command1_Click()
    Dim s As String
    s = "中国人民解放军"
    TextOut Me.hdc, 10, 100, s, LenB(StrConv(s, vbFromUnicode)) '须转换
End Sub

另一个文字输出：DrawText

注意：文字是当作一幅“画”在看侍

'在指定区域内输出文字。
'如果指定区域设置小了，文字超过后就不会显示出来
Private Declare Function DrawText _
                Lib "user32" _
                Alias "DrawTextA" (ByVal hdc As Long, _
                                   ByVal lpStr As String, _
                                   ByVal nCount As Long, _
                                   lpRect As RECT, _
                                   ByVal wFormat As Long) As Long

'wFormat文字输出格式，DT即Draw Text
Private Const DT_BOTTOM = &H8 '靠底输出，必须与DT_SINGLELINE配合（用OR）
Private Const DT_CENTER = &H1  '居中
Private Const DT_CALCRECT = &H400  '自动计算（调整）输出区域的大小
Private Const DT_EXPANDTABS = &H40   '将Tab字符视为定位点
Private Const DT_EXTERNALLEADING = &H200 '包含行间距
Private Const DT_LEFT = &H0           '居左
Private Const DT_NOCLIP = &H100    '文字输出不受限于输出区域
Private Const DT_NOPREFIX = &H800 '不处理前导字符&。若不指定，会把紧跟的字母加下划线（类似定义菜单快捷键）
Private Const DT_RIGHT = &H2       '居右
Private Const DT_SINGLELINE = &H20  '单行输出
Private Const DT_TABSTOP = &H80   '设置定位点，wFormat中高字节8-15位表示定位点的宽度（默认8）
Private Const DT_TOP = &H0       '居上，须与DT_SINGLELINE配合
Private Const DT_VCENTER = &H4   '垂直居中，须与DT_SINGLELINE配合
Private Const DT_WORDBREAK = &H10 '超过右边界时，自动换行

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Sub Command1_Click()
    Dim s As String, r As RECT

    s = "API（ApplicationProgrammingInterface,应用程序编程接口）是一些预先定义的函数，目的是"
    r.Left = 10
    r.Top = 10
    r.Bottom = 100
    r.Right = 100
    '下面会显示不全，可用DT_WORDBREAK代替wFormat自动换行，可用DT_NOCLIP不受矩形区域限制直接输出
    DrawText Me.hdc, s, LenB(StrConv(s, vbFromUnicode)), r, DT_BOTTOM Or DT_SINGLELINE
End Sub

区域的大小判断时，可用API： GetTextExtentPoint32 来取得文字输出区域的宽和高，从而为设置区域定下标准

'计算字串所点区域大小，
Private Declare Function GetTextExtentPoint32 _
                Lib "gdi32" _
                Alias "GetTextExtentPoint32A" (ByVal hdc As Long, _
                                               ByVal lpsz As String, _
                                               ByVal cbString As Long, _
                                               lpSize As Size) As Long
'取得值在最后一个参数，它指明区域范围。cbString是以字节为单位计算字串长度
Private Type Size
    cx As Long   '宽
    cy As Long   '高
End Type

比较有意思的是：DrawText含有一个自动计算功能。只要告诉某些参数，就可以计算出相应的区域大小，进行自动填写。

dim r as rect

r.top=10

r.left=10

DrawText me.hdc, s,len(s),r,DT_CALCRECT

这样，区域只定了左上角点，但它会自动计算S得出右下角点，并填充到R相应值中。注意这是假定单行时。

若要多行，则需再指定一个值。如果我们再指定一个右边R.right，则会自动计算下界并填充。同理，再指定下界，会自动计算右界并填充。