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

来源:互联网 发布:ios微信数据恢复 编辑:程序博客网 时间:2024/05/20 01:11

回顾: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 hOldBrushEnd 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 LongPrivate Declare Function SetPolyFillMode _                Lib "gdi32" (ByVal hdc As Long, _                             ByVal nPolyFillMode As Long) As LongPrivate Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As LongPrivate Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate Declare Function SelectObject _                Lib "gdi32" (ByVal hdc As Long, _                             ByVal hObject As Long) As LongPrivate Type POINTAPI    x As Long    y As LongEnd TypePrivate Const ALTERNATE = 1Private Const WINDING = 2Private 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 LongPrivate Declare Function SelectObject _                Lib "gdi32" (ByVal hdc As Long, _                             ByVal hObject As Long) As LongPrivate Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate 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 LongPrivate Declare Function FloodFill _                Lib "gdi32" (ByVal hdc As Long, _                             ByVal x As Long, _                             ByVal y As Long, _                             ByVal crColor As Long) As LongPrivate Declare Function CreatePen _                Lib "gdi32" (ByVal nPenStyle As Long, _                             ByVal nWidth As Long, _                             ByVal crColor As Long) As LongPrivate Const PS_SOLID = 0Private 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 hBrushEnd 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 ExplicitDeclare 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 LongPublic px(2048) As LongPublic py(2048) As LongPublic npoint   As LongSub LineDDAProc(ByVal X As Long, ByVal Y As Long, ByVal lpData As Long)    px(npoint) = X    py(npoint) = Y    npoint = npoint + 1End 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    NextEnd SubPrivate 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 ExplicitPrivate Declare Function PtInRegion _                Lib "gdi32" (ByVal hRgn As Long, _                             ByVal X As Long, _                             ByVal Y As Long) As LongPrivate Declare Function CreateEllipticRgn _                Lib "gdi32" (ByVal X1 As Long, _                             ByVal Y1 As Long, _                             ByVal X2 As Long, _                             ByVal Y2 As Long) As LongPrivate 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 LongPrivate Declare Function CreatePolygonRgn _                Lib "gdi32" (lpPoint As POINTAPI, _                             ByVal nCount As Long, _                             ByVal nPolyFillMode As Long) As LongPrivate Declare Function Polygon _                Lib "gdi32" (ByVal hdc As Long, _                             lpPoint As POINTAPI, _                             ByVal nCount As Long) As LongPrivate Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As LongPrivate Declare Function SelectObject _                Lib "gdi32" (ByVal hdc As Long, _                             ByVal hObject As Long) As LongPrivate Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate Const ALTERNATE = 1Private Const WINDING = 2Private Type POINTAPI    X As Long    Y As LongEnd TypeDim p(4)     As POINTAPIDim hPolyRgn As LongPrivate 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 hBrushEnd SubPrivate 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 = 200End SubPrivate 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 IfEnd 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 TypePrivate Declare Function SelectObject _                Lib "gdi32" (ByVal hDC As Long, _                             ByVal hObject As Long) As LongPrivate Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate Declare Sub RtlMoveMemory _                Lib "KERNEL32" (lpvDest As Any, _                                lpvSource As Any, _                                ByVal cbCopy As Long)Private Const LF_FACESIZE = 32Private Const DEFAULT_CHARSET = 1Private 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 hFontEnd SubPrivate 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 TextPrivate 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 LongEnd TypePrivate 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_SINGLELINEEnd 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,则会自动计算下界并填充。同理,再指定下界,会自动计算右界并填充。










        




原创粉丝点击