Windows API 初步之-- 绘图函数

清风_ll

前言


（本文针对初学者，高手请自便^_^）

我们都知道VBA本身提供的功能是非常有限的，很多的功能我们不得不调用API函数来实现。而面对着API函数复杂的结构，很多初学者刚接触时都会很难接受，这其中当然也包括我。但作为一个真正的VBA 粉丝，您是否就此驻足不前了呢，不是吧?


其实大部分的API函数还都是比较容易理解和看懂的，其使用方法与我们的自定义函数完全相同,最主要的区别只在于在使用API函数之前我们必须先对它进行一下声明,但这些API声明我们可以从APIVIEW中直接拷贝过来,并不需要死记,我们只要知道某个函数实现何种功能就可以了.只要您有决心学习，那么您就一定能学好。


提供一些链接：

API基础 ：http://club.excelhome.net/viewth ... replyID=&skin=02楼


必备工具：
apiViewer     http://club.excelhome.net/dispbb ... p;skin=0&Star=330楼
VBAPI.CHM   http://club.excelhome.net/viewth ... replyID=&skin=0


废话就不多说了，直奔主题，现在让我们从绘图函数开始一起学习吧，因我也是刚学不久，所以难免会出现误解，如果误导了您当见谅。在学习中如果您有什么问题可以提出，我们看看能不能解决。
首先我们先分开来实现每一个工具,在最后，我们将把这些功能结合起来，模仿一下微软小画家做一个画图程序


相关说明：

字体显示红色为API函数名。
字体显示蓝色为API函数功能。
字体显示绿色为个人对该函数的理解。

[此贴子已经被作者于2006-7-11 16:36:51编辑过]

清风_ll

这个程序让我们在实现一个铅笔工具的功能。 gTrZ7eRE.zip (19.59 KB, 下载次数: 423)

2006-4-21 13:06 上传

点击文件名下载附件
实现铅笔工具功能

我们来分析一下程序：一些与绘图函数不大相关的就不分析了，比如其中的类模块以及一些函数之类的，使用类模块主要是为了减少代码 程序中用到了以下几个API函数: Public Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long Public Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long Public Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long Public Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long Public Declare Function SetPixelV Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long Public Declare Function CreatePen Lib "gdi32.dll" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long Public Declare Function LineTo Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long Public Declare Function MoveToEx Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByRef lpPoint As POINTAPI) As Long API函数说明: ---------------------------------------------------------- GetDC VB声明 Declare Function GetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Long) As Long 说明 获取指定窗口的设备场景 返回值 Long，指定窗口的设备场景句柄，出错则为0 参数表 参数类型及说明 hwndLong，将获取其设备场景的窗口的句柄。若为0，则要获取整个屏幕的DC 注解 若窗口所属类具有CS_OWNDC， CS_CLASSDC 或 CS_PARENTDC样式，则获取的设备场景属窗口或类专有。vb的窗体和图片框控件也是这种情况，它用该函数取得的结果和控件的hdc属性相同（在autoredraw为FALSE时）。您无须考虑取回的窗体或图片框控件设备场景的默认状态，特别是绘图对象。另外，默认状态随着窗体和控件autoredraw属性的设置而不同。在设备场景释放前您必须回复其状态为初始值。对于没有CS_OWNDC， CS_CLASSDC 或 CS_PARENTDC样式的窗口的设备场景，可从通用windows缓存中获取，其状态为默认值。缓存中可用设备场景数量是有限的，因此只要可能就释放设备场景 用本函数获取的设备场景一定要用ReleaseDC函数释放，不能用DeleteDC ---------------------------------------------------------- 几乎所有的绘图函数都需要一个设备场景作为参数,我们可以用GetDC函数来获得它,这个函数中只有一个参数,那就是窗口句柄.如果我们知道了窗口句柄就可以很容易的获得(程序中使用ListView控件来作为画布的一个主要原因就是该控件提供了hWnd属性,另一个原因就是该控件的Mouse事件中使用的坐标就是设备场景中所用的逻辑坐标,这样我们就省去了换算了.当然可能多占点内存,但这不是我们在这里要讨论的问题了) ---------------------------------------------------------- ReleaseDC VB声明 Declare Function ReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Long, ByVal hdc As Long) As Long 说明 释放由调用GetDC或GetWindowDC函数获取的指定设备场景。它对类或私有设备场景无效（但这样的调用不会造成损害） 返回值 Long，执行成功为1，否则为0 参数表 参数类型及说明 hwndLong，要释放的设备场景相关的窗口句柄 hdcLong，要释放的设备场景句柄 注解 对那些用CreateDC一类的DC创建函数生成的设备场景，不要用本函数 ----------------------------------------------------------- 上面注解中已说明了,使用GetDC获取的设备场景我们需要使用ReleaseDC函数来释放它.在相关的教程中建议在每一个过程中都重新用GetDC获取DC并在过程结束时释放它。我是半路出家，对此不甚了解，你自已看着办吧） ----------------------------------------------------------- SelectObject VB声明 Declare Function SelectObject Lib "gdi32" Alias "SelectObject" (ByVal hdc As Long, ByVal hObject As Long) As Long 说明 每个设备场景都可能有选入其中的图形对象。其中包括位图、刷子、字体、画笔以及区域等等。一次选入设备场景的只能有一个对象。选定的对象会在设备场景的绘图操作中使用。例如，当前选定的画笔决定了在设备场景中描绘的线段颜色及样式 返回值 Long，与以前选入设备场景的相同hObject类型的一个对象的句柄，零表示出错。如选定的对象是一个区域（Region），结果就是下列常数之一：SIMPLEREGION， COMPLEXREGION 或 NULLREGION 对区域进行描述， GDI_ERROR 表示出错 参数表 参数类型及说明 hdcLong，一个设备场景的句柄 hObjectLong，一个画笔、位图、刷子、字体或区域的句柄 注解 返回值通常用于获得选入DC的对象的原始值。绘图操作完成后，原始的对象通常选回设备场景。在清除一个设备场景前，务必注意恢复原始的对象 ---------------------------------------------------------- 这个函数让我们选择当前设备场景中的对象，我们可以先产生一个对象再把对象选进设备场景中去。说明中说到：一次选入设备场景的只能有一个对象。选定的对象会在设备场景的绘图操作中使用。例如，当前选定的画笔决定了在设备场景中描绘的线段颜色及样式。这只是针对每个对象，但我们可以选择多个对象，比如我们选择了画笔，我们同时也可以选择刷子 ---------------------------------------------------------- DeleteObject VB声明 Declare Function DeleteObject Lib "gdi32" Alias "DeleteObject" (ByVal hObject As Long) As Long 说明 用这个函数删除GDI对象，比如画笔、刷子、字体、位图、区域以及调色板等等。对象使用的所有系统资源都会被释放 返回值 Long，非零表示成功，零表示失败 参数表 参数类型及说明 hObjectLong，一个GDI对象的句柄 注解 不要删除一个已选入设备场景的画笔、刷子或位图。如删除以位图为基础的阴影（图案）刷子，位图不会由这个函数删除——只有刷子被删掉 ---------------------------------------------------------- 与GetDC和ReleaseDC一样，此函数删除一个已选进设备场景的对象，相关教程中建议在对象不在需要的时候删除它。在清除对象之后，设备场景恢复默认对象。 ---------------------------------------------------------- SetPixelV VB声明 Declare Function SetPixelV Lib "gdi32" Alias "SetPixelV" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long 说明 在指定的设备场景中设置一个像素的RGB值 返回值 Long，非零表示成功，零表示失败。会设置GetLastError 参数表 参数类型及说明 hdcLong，一个设备场景的句柄 x,yLong，要设置的点，用逻辑坐标表示 crColorLong，指定像素的新RGB颜色值 注解 这个函数比SetPixel快一些，但不会返回设置的实际颜色。可用GetDeviceCaps判断设备是否支持这个函数 ---------------------------------------------------------- 这个函数很简单，没什么可说的，把场景中相应的点设置为我们要设置的颜色。- --------------------------------------------------------- CreatePen VB声明 Declare Function CreatePen Lib "gdi32" Alias "CreatePen" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long 说明 用指定的样式、宽度和颜色创建一个画笔 返回值 Long，如函数执行成功，就返回指向新画笔的一个句柄；否则返回零 参数表 参数类型及说明 nPenStyleLong，指定画笔样式，可以是下述常数之一 PS_SOLID画笔画出的是实线 PS_DASH画笔画出的是虚线（nWidth必须是1） PS_DOT画笔画出的是点线（nWidth必须是1） PS_DASHDOT画笔画出的是点划线（nWidth必须是1） PS_DASHDOTDOT画笔画出的是点-点-划线（nWidth必须是1） PS_NULL画笔不能画图 PS_INSIDEFRAME画笔在由椭圆、矩形、圆角矩形、饼图以及弦等生成的封闭对象框中画图。如指定的准确RGB颜色不存在，就进行抖动处理 nWidthLong，以逻辑单位表示的画笔的宽度 crColorLong，画笔的RGB颜色 注解 一旦不再需要画笔，记得用DeleteObject函数将其删除 ---------------------------------------------------------- 在代码中我们使用CreatePen来生成一个新的画笔，然后用SelectObject把它选进设备场景中 ---------------------------------------------------------- OK，下面我们来看看主要的过程 Private Sub Canvas_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS) pStart.x = x pStart.y = y Pen Button, x, y, True End Sub 画布MouseDown事件中，我们使用一个POINTAPI结构类型的变量来保存它，并把鼠标按键信息，当前位置传递给Pen过程，最后一个参数在Pen过程中表示为是MouseDown事件，在Pen过程中我们根据是MouseDown事件还是MouseMove事件来执行不同代码，实际上我们也可以把Pen过程中的代码分别放入各事件当中的。这就看个人喜好了 Private Sub Canvas_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS) If Button <> 0 Then Pen Button, x, y, False’如果有按键信息执行代码 End Sub 下面就是主要功能代码了 Sub Pen(Button As Integer, xx As Long, yy As Long, MDown As Boolean) '铅笔 Dim pt As POINTAPI Dim nColor As Long, dc As Long dc = GetDC(hCanvas)’获得设备场景句柄，hCanvas是画布窗口ListView控件句柄 If MDown Then’判断是否是MouseDown事件发生 If Button = 1 Then’判断是左键还是右键 nColor = FrColor’左键时，使用前景色 ElseIf Button = 2 Then nColor = BkColor’右键时，使用背景色 End If SetPixelV dc, xx, yy, nColor，把当前位置设置成我们要设置的颜色 Else’MouseMove事件时执行以下代码 If Button = 1 Then’左键 hPen0 = CreatePen(0, 1, FrColor)’左键使用前景色生成新画笔，这里第一个参数为0，我们要生成一个实线画笔 ElseIf Button = 2 Then’右键 hPen0 = CreatePen(0, 1, BkColor)’右键使用前景色生成新画笔，常数PS_SOLID=0，线条大小为１象素 End If pStop.x = xx’把当们位置保存进变量中 pStop.y = yy’ SelectObject dc, hPen0’将画笔选进设备场景中，之后我们就可以用我们设置的画笔作画了：） MoveToEx dc, pStart.x, pStart.y, pt’ LineTo dc, pStop.x, pStop.y DeleteObject hPen0’删除画笔 pStart.x = pStop.x’将当前位置作为开始位置 pStart.y = pStop.y End If DeleteObject hPen0’删除画笔，这里是多余的，并不会发生错误 ReleaseDC hCanvas, dc’释放设备场景 End Sub 好了，这个小程序分析完毕，您可有收获吗？如果您有什么疑问，请跟贴 咦，等等，还有LineTo及MoveToex函数还没解析呢？这两个函数又是做什么和如何使用的呢?嗯，别急，在楼下我们将对它进行解释。这里先简单的说一下: LineTo函数在场景中画一条直线，哦,既然是画直线，那为什么在铅笔工具中要用直线呢，这是因为当我们在画布中移动的速度过快时，如果用SetPixelV那么有可能会出现断节现象。明白了吧^_^ OK，您也累了吧？歇一下，喝杯茶先……

[此贴子已经被作者于2006-4-21 13:07:33编辑过]

清风_ll

p7pGG1Ln.zip (16.27 KB, 下载次数: 270)

2006-4-21 13:09 上传

点击文件名下载附件
直线工具

以下我们对主要问题进行分析 在这个程序中用到的函数与一楼的是一样的,因为有几个函数在一楼已经解释,在这里我们只对 Declare Function MoveToEx Lib "gdi32" Alias "MoveToEx" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long Declare Function LineTo Lib "gdi32" Alias "LineTo" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long 这两个函数进行解释 －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ LineTo VB声明 Declare Function LineTo Lib "gdi32" Alias "LineTo" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long 说明 用当前画笔画一条线，从当前位置连到一个指定的点。这个函数调用完毕，当前位置变成x,y点 返回值 Long，非零表示成功，零表示失败 参数表 参数类型及说明 hdcLong，设备场景的句柄 x,yLong，线段终点位置，采用逻辑坐标表示。这个点不会实际画出来；它不属于线段的一部分 注解 如重复调用这个函数和一个几何画笔，从而创建一系列线段，那么除非在一个路径的场景中调用，否则不会认为这些线段已结合到一起 －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ 这个函数好象很简单,是吧?只有三个参数,一个是设备场景,另外两个是终点位置,函数实现从当前位置到终点位置间画一条直线,使用当前场景选取的画笔,那么当前位置是哪里呢? 如果您还没有调用过该函数和其它能修改画笔起点的函数之前,那么当前位置在场景原点,坐标(0,0),一旦调用该函数之后,函数参数中的终点位置就被设置为当前位置了,如果你一直调用该函数,那么你会得到一条相连的线段,那么如果我们要在指定的位置画一条直线怎么办呢?还好,微软提供了另一个函数MoveToEx －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ MoveToEx VB声明 Declare Function MoveToEx Lib "gdi32" Alias "MoveToEx" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long 说明 为指定的设备场景指定一个新的当前画笔位置。前一个位置保存在lpPoint中 返回值 Long，非零表示成功，零表示失败 参数表 参数类型及说明 hdcLong，指向一个设备场景的句柄 x,yLong，采用逻辑坐标表示的新画笔位置 lpPointPOINTAPI，用于保存前一个画笔位置。可以为NULL（将参数改为ByVal As Long，以传递一个空参数） 注解 在一个路径分支中描绘的时候，这个函数会创建一个新的子路径 －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ MoveToEx函数为指定的设备场景指定一个新的当前画笔位置，并把原位置信息保存在一个POINTAPI结构的变量中，我们为了理想的实现在场景中画一条指定的直线，那么我们应该先把当前位置设置好，然后再使用LineTo来达到我们的目的 代码分析： Private Sub Canvas_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS) Dim nColor As Long pStart.x = x'把当前位置保存进第一个点中 pStart.y = y dc = GetDC(hCanvas) If Button = 1 Then nColor = FrColor Else nColor = BkColor'设置指定颜色，当左键时为前景颜色，右键时为背景颜色 SetPixelV dc, x, y, nColor'用相应颜色标识第一个位置 ReleaseDC hCanvas, dc End Sub 以上我们实现在鼠标按下时确定第一个点位置 Private Sub Canvas_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS) Dim pt As POINTAPI, nColor As Long dc = GetDC(hCanvas) If Button = 1 Then nColor = FrColor Else nColor = BkColor hPen0 = CreatePen(0, 1, nColor) SelectObject dc, hPen0 MoveToEx dc, pStart.x, pStart.y, pt＇把为画笔重新设置当前位置，把第一个点位置设置为当前画笔起点，在这里我们不需要原来的位置信息，但我们也必须要使用一个PIONTAPI结构的变量来保存它 LineTo dc, x, y'从当前画笔起点到终点之间画一条直线 DeleteObject hPen0'当然我们必须删除画笔有释放设备场景 ReleaseDC hCanvas, dc End Sub 在鼠标松开时确定终点位置，并在第一个点到终点之间画一条直线 当然，如果您愿意，您也可以在MouseMove事件中添加代码，以实现即时效果 LineTo函数使用方法就是这样了，现在我们总结一下： 首先用MoveToEx函数重新设置画笔当前位置； 然后使用LineTo函数就可以达到我们想要的线条了。

[此贴子已经被作者于2006-4-21 13:09:59编辑过]

清风_ll

hlPZPbca.zip (17.79 KB, 下载次数: 145)

2006-4-21 13:13 上传

点击文件名下载附件
橡皮擦工具

橡皮擦工具其实就是简单的把区域范围的颜色设置为背景颜色就OK了，对区域填充颜色的方法有多种，我们这里用FillRect函数实现 －－－－－－－－－－－－－－－－－－－－－－－－－－－－ FillRect VB声明 Declare Function FillRect Lib "user32" Alias "FillRect" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long 说明 用指定的刷子填充一个矩形 返回值 Long，非零表示成功，零表示失败。会设置GetLastError 参数表 参数类型及说明 hdcLong，设备场景的句柄 lpRectRECT，对填充区域进行描述的一个矩形，采用逻辑坐标 hBrushLong，欲使用的刷子的句柄 注解 矩形的右边和底边不会描绘 －－－－－－－－－－－－－－－－－－－－－－－－－－－－ 函数为设备场景中指定的矩形用指定的刷子进行填充，hBrush为指定刷子的句柄，为了实现该功能我们必须获得此句柄，创建刷子的函数有多个。在这个演示中我们用CreateSolidBrush创建一个纯色刷子 －－－－－－－－－－－－－－－－－－－－－－－－－－－－ CreateSolidBrush VB声明 Declare Function CreateSolidBrush Lib "gdi32" Alias "CreateSolidBrush" (ByVal crColor As Long) As Long 说明 用纯色创建一个刷子 返回值 Long，如执行成功，返回新刷子的一个句柄；否则返回零 参数表 参数类型及说明 crColorLong，数字的RGB彩色 注解 一旦刷子不再需要，就用DeleteObject函数将其删除 －－－－－－－－－－－－－－－－－－－－－－－－－－－－ CreateSolidBrush函数用指定的颜色创建一个刷子，并返回刷子的句柄 －－－－－－－－－－－－－－－－－－－－－－－－－－－－ 函数介绍完毕，下面对主要代码进行分析： Sub Rubber(ByVal xx As Single, ByVal yy As Single) '橡皮擦 Dim dc As Long Dim rRct As RECT'定义一个RECT类型变量 dc = GetDC(hCanvas) hBrush = CreateSolidBrush(BkColor)'用背景颜色创建一个刷子，并把刷子句柄保存在hBrush变量中 With rRct’指定矩形范围 .Left = xx .Top = yy .Right = xx + 9’指定一个9*9像素的矩形进行填充，并非10*10矩形，因为底边和右边不会进行描绘 .Bottom = yy + 9 End With FillRect dc, rRct, hBrush’用hBrush 刷子对矩形进行填充 DeleteObject hBrush’当然不要忘记删除对象 ReleaseDC hCanvas, dc’以及释放设备场景 End Sub 很简单的就实现了这个功能了，想不到吧？当然您也可以试试用其它的方法及形状来填充它。祝您成功。

[此贴子已经被作者于2006-4-21 13:13:41编辑过]

清风_ll

UmXgTT7L.zip (19.25 KB, 下载次数: 189)

2006-4-21 13:15 上传

点击文件名下载附件
矩形工具

在这里我们只介绍两个新的API函数: Public Declare Function GetStockObject Lib "gdi32.dll" (ByVal nIndex As Long) As Long Public Declare Function Rectangle Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long ----------------------------------------------------- GetStockObject VB声明 Declare Function GetStockObject Lib "gdi32" Alias "GetStockObject" (ByVal nIndex As Long) As Long 说明 取得一个固有对象（Stock）。这是可由任何应用程序使用的windows标准对象之一 返回值 Long，指向指定对象的一个句柄。零表示出错 参数表 参数 类型及说明 nIndex Long，下述表格中定义的任何常数之一 BLACK_BRUSH 黑色刷子 DKGRAY_BRUSH 黑灰色刷子 GRAY_BRUSH 灰色刷子 HOLLOW_BRUSH 凹刷子 LTGRAY_BRUSH 浅灰色刷子 NULL_BRUSH 空刷子 WHITE_BRUSH 白色刷子 BLACK_PEN 黑色画笔 NULL_PEN 空画笔 WHITE_PEN 白色画笔 …… ----------------------------------------------------- 这个函数用来取得系统预定义的一些对象，包括画笔，刷子和字体以及调色板。在这个程序中我们只用它来创建一个空画笔nIndex=NULL_BRUSH，以生成一个透明效果的矩形,因版面问题，其它类型不列入内，您可以从CHM帮助文件中找到它。 ----------------------------------------------------- Rectangle VB声明 Declare Function Rectangle Lib "gdi32" Alias "Rectangle" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long 说明 用当前选定的画笔描绘矩形，并用当前选定的刷子进行填充 返回值 Long，非零表示成功，零表示失败。会设置GetLastError 参数表 参数 类型及说明 hdc Long，设备场景的句柄 X1,Y1 Long，指定矩形左上角位置 X2,Y2 Long，指定矩形右下角位置 ----------------------------------------------------- 说明中说得很清楚了，我们只需要在调用它之前为当前设备场景选择一个画笔以及刷子就可以实现在场景中画一个矩形了。 ----------------------------------------------------- 代码分析： Private Sub Canvas_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS) If Button = 1 Then pStart.x = x pStart.y = y End If End Sub 在鼠标左键按下时，记住起点位置 Private Sub Canvas_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS) If Button = 1 Then dc = GetDC(hCanvas) Select Case intFillMode’选择填充模式 Case 1’只画矩形边框 hPen0 = CreatePen(0, 1, FrColor)’用前景色生成一个画笔 hBrush = GetStockObject(NULL_BRUSH)’成一个空刷子 Case 2’画前景色为边框并用背景色填充矩形 hPen0 = CreatePen(0, 1, FrColor)’用前景色生成一个画笔 hBrush = CreateSolidBrush(BkColor)’用背景色生成一个刷子 Case 3’用背景填充一个矩形 hPen0 = CreatePen(0, 1, BkColor)’用背景色生成一个画笔 hBrush = CreateSolidBrush(BkColor)’用背景色生成一个刷子 End Select SelectObject dc, hPen0’为设备场景选择画笔 SelectObject dc, hBrush’为设备场景选择刷子 Rectangle dc, pStart.x, pStart.y, x, y’用当前画笔和刷子填充矩形 DeleteObject hPen0 DeleteObject hBrush ReleaseDC hCanvas, dc End If End Sub 在鼠标左键松开时,用我们设置的画笔及刷子对矩形进行填充。 OK，收工 说明一下：在此程序中只有当鼠标移动方向为从左上到右下时才会画一个矩形，您可以试着修改它，让它无论如何移动都可以画出这样的一个矩形来，这个任务交给你了 在程序中提供了一个选择填充方式的框架，您可以使用它来选择填充方式，因不是要介绍的内容，所以这个框架中没有提示你选择的是哪个，但是毫无问题它是可以用来选择的。

[此贴子已经被作者于2006-4-21 13:15:26编辑过]

清风_ll

Nb1Xc2Xc.zip (17.88 KB, 下载次数: 136)

2006-4-21 13:16 上传

点击文件名下载附件
椭圆工具

基本上画一个椭圆与上面画一个矩形的方法是一样的，只不过是把画矩形的函数改为一个画椭圆的函数罢了，而且参数完全相同，这里就不再多说了，相信聪明如我的你一定可以看明白。 ----------------------------------------- Ellipse VB声明 Declare Function Ellipse Lib "gdi32" Alias "Ellipse" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long 说明 描绘一个椭圆，由指定的矩形围绕。椭圆用当前选择的画笔描绘，并用当前选择的刷子填充 返回值 Long，非零表示成功，零表示失败。会设置GetLastError 参数表 参数 类型及说明 hdc Long，设备场景的句柄 X1，Y1 Long，约束矩形采用逻辑坐标的左上角位置 X2，Y2 Long，约束矩形采用逻辑坐标的右下角位置 ----------------------------------------- 这里留一个问题：画矩形和画椭圆我们做出来了，那画正方形和圆怎么画呢？

[此贴子已经被作者于2006-4-21 13:17:16编辑过]

清风_ll

frFGPDfj.zip (17.92 KB, 下载次数: 137)

2006-4-21 13:18 上传

点击文件名下载附件
圆角矩形工具

----------------------------------------------------------- RoundRect VB声明 Declare Function RoundRect Lib "gdi32" Alias "RoundRect" (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定义了用于生成圆角的椭圆 返回值 Long，非零表示成功，零表示失败。会设置GetLastError 参数表 参数 类型及说明 hdc Long，用于绘图的设备场景 X1,Y1 Long，对矩形左上角位置进行说明的X，Y坐标 X2,Y2 Long，对矩形右下角位置进行说明的X，Y坐标 X3 Long，用于生成圆角效果的一个椭圆的宽度。取值范围从零（表示不加圆角），一直到矩形的宽度（全圆） Y3 Long，用于生成圆角效果的一个椭圆的高度。取值范围从零（表示不加圆角），一直到矩形的高度（全圆） ----------------------------------------------------------- 我们看一下程序中的一句代码： RoundRect dc, pStart.x, pStart.y, x, y, 15, 15 不知道你理解了X3，Y3这两个参数没有，我的理解是：在矩形的每一个内直角中用一个直径为15个像素的圆与之内切，内切圆与两边之间的弧线作为圆角。 当我们把X3，Y3都设置为0时，我们可以得到一个矩形： RoundRect dc, pStart.x, pStart.y, x, y, 0, 0 当我们把X3,Y3设置成矩形相应方向的边长时，我们得到一个椭圆： RoundRect dc, pStart.x, pStart.y, x, y, x - pStart.x, y - pStart.y 到这里我们发现这个函数功能包含了画矩形和椭圆的功能,其实我们只用这个函数就可以实现画矩形，画圆，画圆角矩形了。

[此贴子已经被作者于2006-4-21 13:18:24编辑过]

清风_ll

syt33hPx.zip (22.11 KB, 下载次数: 142)

2006-4-21 13:19 上传

点击文件名下载附件
多边形工具

在这里我们来学习两个新的函数: Public Declare Function SetPolyFillMode Lib "gdi32.dll" (ByVal hdc As Long, ByVal nPolyFillMode As Long) As Long Public Declare Function Polygon Lib "gdi32.dll" (ByVal hdc As Long, ByRef lpPoint As POINTAPI, ByVal nCount As Long) As Long ------------------------------------------------------ SetPolyFillMode VB声明 Declare Function SetPolyFillMode Lib "gdi32" Alias "SetPolyFillMode" (ByVal hdc As Long, ByVal nPolyFillMode As Long) As Long 说明 设置多边形的填充模式。参考GetPolyFillMode函数的注解 返回值 Long，如执行成功，返回前一种多边形填充模式。零表示出错 参数表 参数 类型及说明 hdc Long，设备场景的句柄 nPolyFillMode Long，下述常数之一： ALTERNATE 交替填充 WINDING 根据绘图方向填充 填充模式1——ALTERNATE：为判断一个点是否位于填充区，windows会从这个点到图形外部画一条假想的线。每与一条线相交，计数器就会增1。如最后一个记数是奇数，则填充这个点；如果是偶数，则保留原样不变 填充模式2——WINDING：为判断一个点是否位于填充区，windows会从这个点到图形外部画一条假想的线。windows会跟踪画出每个顶点（线段）的方向。这条假想的线每次穿过一个顶点时，而且顶点的Y方向为正，则减一个记数。如结果记数不是零，就表明该点位于填充区域 我们要对所有的点都填充进来，使用Winding常数。 ------------------------------------------------------ Polygon VB声明 Declare Function Polygon Lib "gdi32" Alias "Polygon" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long 说明 描绘一个多边形，由两点或三点的任意系列构成。windows会将最后一个点与第一个点连接起来，从而封闭多边形。多边形的边框用当前选定的画笔描绘，多边形用当前选定的刷子填充 返回值 Long，非零表示成功，零表示失败。会设置GetLastError 参数表 参数 类型及说明 hdc Long，用于描绘的设备场景 lpPoint POINTAPI，在nCount POINTAPI结构数组中的第一个POINTAPI结构 nCount Long，多边形的总点数（顶点数） 注解 GetPolyFillMode 和 SetPolyFillMode 函数决定了如何在多边形内部填充 ------------------------------------------------------ 第一个参数DC不用说了，第二个是一个POINTAPI结构数组中的第一个结构，也就是第一个点了。nCount 总的点数，我们用数组的上限UBound()来获得 我们来看实现的代码： Private Sub Canvas_DblClick()'双击结束多边形绘制 hPen0 = Pen'创建画笔 hBrush = Brush'创建刷子 SelectObject dc, hPen0'选择画笔 SelectObject dc, hBrush'选择刷子 SetPolyFillMode dc, WINDING'设置填充模式 Polygon dc, Points(0), UBound(Points) + 1'绘制多边形 DeleteObject hPen0 DeleteObject hBrush bPaint = False End Sub 以上代码结束一个多边形的绘制. Private Sub Canvas_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS) If Button = 1 Then If bPaint = False Then'开始绘制时确定第一个点 bPaint = True Erase Points'删除数组 ReDim Points(0) As POINTAPI'重定义数组 Points(0).x = x'数组第一个项作为第一个点 Points(0).y = y SetPixelV dc, x, y, FrColor'用前景色标识点 MoveToEx dc, x, y, pt'把画笔起点到此点 Else'绘制过程中为数组增加一个点并且与前一位置用一条直线相连 ReDim Preserve Points(UBound(Points) + 1) As POINTAPI'为数组(多边形)新增一个点 Points(UBound(Points)).x = x Points(UBound(Points)).y = y hPen0 = Pen SelectObject dc, hPen0 LineTo dc, x, y'画一条直线 DeleteObject hpen End If End If End Sub Private Sub Canvas_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS) If x = Points(0).x And y = Points(0).y Then'如果点与多边形第一个点相同,则结束绘制 Canvas_DblClick Else'否则为多边形新增一个点 ReDim Preserve Points(UBound(Points) + 1) As POINTAPI Points(UBound(Points)).x = x Points(UBound(Points)).y = y hPen0 = Pen SelectObject dc, hPen0 LineTo dc, x, y'画一条直线 DeleteObject hpen End If End Sub 这个解释起来有点费劲

[此贴子已经被作者于2006-4-21 13:19:56编辑过]

清风_ll

IyJZlmer.zip (29.4 KB, 下载次数: 120)

2006-4-21 13:21 上传

点击文件名下载附件
吸管工具

获取设备场景中某点的颜色信息的函数使用GetPixel函数,在绘图程序中我们叫它为吸管工具,在绘图函数中和SetPixel一样算是比较简单的了. GetPixel VB声明 Declare Function GetPixel Lib "gdi32" Alias "GetPixel" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long 说明 在指定的设备场景中取得一个像素的RGB值 返回值 Long，指定点的RGB颜色。如指定的点位于设备场景的剪切区之外，则返回CLR_INVALID 参数表 参数类型及说明 hdcLong，一个设备场景的句柄 x,yLong，逻辑坐标中要检查的点 注解 用GetDeviceCaps判断设备是否支持本函数 函数返回的结果为Long型,我们可以用一个函数来获得它们的RGB分量 Function GetColorRGB(ByVal nColor As Long, RGB As Integer) As Integer Select Case UCase(RGB) Case 1 '红色 GetColorRGB = nColor Mod 256 Case 2 '绿色 GetColorRGB = nColor \ 256 And 255 Case 3 '蓝色 GetColorRGB = nColor \ 65536 And 255 End Select End Function

[此贴子已经被作者于2006-4-21 13:21:20编辑过]

清风_ll

OmTKP44O.zip (17.97 KB, 下载次数: 165)

2006-4-21 13:49 上传

点击文件名下载附件
文本工具

[此贴子已经被作者于2006-4-21 13:49:07编辑过]