在vba中用lineto函数画线时如何修改线型、大小、颜色？

在如何在vba中用GDI函数LineTo在屏幕上画线？一文中我们介绍了用gdi函数lineto在屏幕上画线。

如果对所画的线的大小、颜色等不满意，想要调整，这时候可以使用如下的步骤：

1.用CreatePen函数创建一个画线用的表，设置它的线型、大小、颜色。

2.用SelectObject函数将该字体添加到DC中，这样凡是与该DC关联的GDI函数都将使用这个笔进行画线。

3.用DeleteObject函数删除添加的笔。

其中CreatePen函数的语法如下：

HPEN CreatePen(
  _In_ int      fnPenStyle,
  _In_ int      nWidth,
  _In_ COLORREF crColor
);

其中fnPenStyle参数为所用的线型，nWidth参数为线的大小，crColor参数为线的颜色。

fnPenStyle参数可以是以下常量

Const PS_SOLID = 0
Const PS_DASH = 1                  '/* -------  */
Const PS_DOT = 2                   '/* .......  */
Const PS_DASHDOT = 3               '/* _._._._  */
Const PS_DASHDOTDOT = 4            '/* _.._.._  */
Const PS_NULL = 5
Const PS_INSIDEFRAME = 6

代码如下：

Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Declare Function LineTo Lib "gdi32" (ByVal hDC As Long, ByVal nXEnd As Long, ByVal nYEnd As Long) As Long
Declare Function MoveToEx Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Type POINTAPI
    x As Long
    y As Long
End Type
Const PS_SOLID = 0
Const PS_DASH = 1                  '/* -------  */
Const PS_DOT = 2                   '/* .......  */
Const PS_DASHDOT = 3               '/* _._._._  */
Const PS_DASHDOTDOT = 4            '/* _.._.._  */
Const PS_NULL = 5
Const PS_INSIDEFRAME = 6
Sub QQ1722187970()
    Dim hDC As Long
    Dim oP As POINTAPI
    hDC = GetDC(0)
    Dim hPen As Long
    hPen = CreatePen(PS_DASH, 1, vbRed)
    SelectObject hDC, hPen
    MoveToEx hDC, 500, 500, oP
    LineTo hDC, 500, 700
    LineTo hDC, 1000, 700
    LineTo hDC, 1000, 500
    LineTo hDC, 500, 500
    ReleaseDC 0, hDC
    DeleteObject hPen
End Sub