网摘》用Picture、API绘图

最新推荐文章于 2022-07-18 15:55:22 发布

yiyiyicz

最新推荐文章于 2022-07-18 15:55:22 发布

阅读量2.2k

点赞数

分类专栏： Visual Basic 6.0

Visual Basic 6.0 专栏收录该内容

36 篇文章 1 订阅

订阅专栏

Picture1.Autoredraw=True 画好的图就不会被抹掉。只有设置为true，才可以在图片框内绘制曲线

Q：根据一组坐标在picture上面画一条线（没有规律），用picture.line方法绘制。当想选中这条线，然后更改这条线的样式，，然后鼠标右键删除。现在是无法选中这条线，，，各位达人有没有好的解决办？

A：第一种办法：不直接使用VB的line命令，而是使用API函数LineDDA，这样可以在回调函数里保存每条线的坐标数组，然后鼠标按下时，遍历所有线条的坐标数组，计算点到直线的距离，判断鼠标位于哪一条线上，再根据该线的坐标数组，使用不同的画笔重绘线条。

缺点：实现较复杂，优点：速度快（可以自设双缓冲）。

第二种办法：不直接使用VB的line命令，而是使用VB本身自带的Line控件，以动态数组方式实现。

缺点：有闪烁现象，优点：代码实现简单。

Private Declare Function ScreenToClient Lib "user32 " (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetCursorPos Lib "user32 " (lpPoint As POINTAPI) As Long
Private Type POINTAPI
                X   As Long
                Y   As Long
End Type

Private Function IsClickLine(pt As POINTAPI, oLine As Line) As Boolean
        Dim a     As Integer, b       As Integer, bret       As Boolean
        On Error GoTo psErr

        a = Int((pt.Y - oLine.Y1) / (pt.X - oLine.X1) * 100)
        b = Int((pt.Y - oLine.Y2) / (pt.X - oLine.X2) * 100)
        Debug.Print "a= " & a & "   b   =   " & b
        If Abs(a - b) <= 20 Then               '允许有20   的误差
                bret = True
        End If
        IsClickLine = bret
        Exit Function
psErr:
        '除数为0   即鼠标点到了端点
        IsClickLine = True
End Function

网上找的，，基本可以达到我要求，，
另外，删除的话，，反色重绘一遍就可以达到效果，

3、调用API绘图函数来绘制温度曲线

为了增强VB的功能，VB提供了访问Windows应用程序接口(Application Programming Interface 即API)的方法，通过API，使编程者可以直接使用Windows操作系统本身为用户提供的种类繁多、功能强大的各种系统功能，编写出性能优异、个性鲜明的应用程序。

3.1 图形设备接口

使用API绘图函数会用到图形设备接口(Graphics Device Interface,即GDI)，GDI为Windows应用程序提供了对屏幕和打印机的设备无关接口，GDI是应用程序和不同类型硬件之间的一层，这种体系结构通过让GDI来解决硬件差异性，将程序员从各种类型硬件设备的直接处理中解脱出来。应用程序可以使用它们在显示器、打印机或其他设备上生成图形化的输出结果,而不必理会具体使用的硬件。

3.2 设备场景

Windows用来为应用程序提供设备无关性的基本工具称为设备场景(Device Context即DC)，DC是内部结构，Windows用它来保留有关输出设备的信息。应用程序将输出发送给DC(而不是直接发送给硬件)，随后由Windows将它发送给硬件。应用程序通过创建设备环境(DC)，可以直接向指定设备进行输出,而不管实际的物理设备。

设备场景总是包含画线的画笔、填充区域的刷子、输出字符的字体和一系列控制设备场景行为的其他值。如果应用程序要画不同颜色的线条,只需在画线前产生一支规定颜色、粗细的画笔,并将这支画笔选入设备场景,然后在设备场景中调用相应画线函数,就可得到期望的结果。

3.3 调用API绘图函数来绘制温度曲线

下面以完全绘制方式来说明如何用API函数绘制温度曲线，假定所有12条温度曲线的温度数据已在一个二维数组Temperature(2999,12)中，每条曲线的颜色值存在LineColor(11)数组中，温度曲线绘制在Picture1上，绘制温度曲线的具体步骤及部分代码如下:

(1) 首先用API函数在内存中建立一个设备环境和与设备环境兼容的位图，作为全部温度曲线的绘图对象。

memDC=GetDC(Picture1.hwnd)c获取Picture1的句柄

hBitmap=CreateCompatibleBitmap(memDC,3000,1300)c产生兼容位图,位图大小为3000@1300像素

hMemDC=CreateCompatibleDC(memDC)c产生兼容设备场景

SelectObjecthMemDC,hBitmapc将位图选进设备环境

RectanglehMemDC,0,0,2700,1300c在内存位图中生成一个矩形,作为绘图区域

(2) 调用API函数中画线函数PolyLine在内存位图中直接绘制12条温度曲线。

For j=0 To 11 ’画12条温度曲线

Hpen=CreatePen(0,1,LineColor(j)) ’产生画笔,决定本条曲线颜色

SelectObjecthMemDC,Hpenc ’将画笔选进设备场景

For i=0 To 2999 ’将1条温度曲线所有温度值和采样周期数传给结构数组lpPoint

lpPoint(i).y=1300-Tempreture(i,j) ’温度值坐标变换

lpPoint(i).x=i

Next i

Polyline hMemDC,lpPoint(0), i-1 ’调用画线函数,1次就将1条曲线完整画出

DeleteObjectHpenc’删除画笔

Nextj ‘至此12条温度曲线已全部画在内存位图中。

(3) 根据当前屏幕上的时间坐标和温度坐标，用API函数BitBlt从已画在内存位图中的整个温度曲线中抓取一个小的局部拷贝，所绘制的温度曲线就可以在屏幕上显示出一部分。

BitBltmemDC,0,0,Picture1.Width,Picture1.Heigh,thMemDC,Xcoun,tYcoun,tSRCCOPYcXcoun,tYcount分别与当前的时间坐标和温度坐标有关。

要抓取在内存位图中的整个温度曲线(3000@1300像素)中的哪一部分,起点由Xcoun,tYcount的值决定,大小由Picture1.Width,Picture1.Height决定。一旦抓取后,只要Xcoun,tYcount的值不改变,就不进行新的抓取,也就是不更新显示。

(4) 在曲线绘制完成后,要用API函数ReleaseDC释放设备场景以便其他应用使用,在窗体关闭也要用API函数DeleteDC删除产生的设备场景和用API函数DeleteObject删除产生的对象以收回系统资源。

ReleaseDCPicture1.hwnd,memDC’释放设备场景

DeleteDChMemDC’删除兼容设备场景

DeleteObjecthBitmap’删除产生的位图

实时绘制方式与完全绘制方式没有本质区别,只不过每次绘图数据只有12个温度值,实时绘制方式是正在对灭菌柜进行验证时进行的。在验证进行时,每到1个采样时刻就会有1组新的温度值送到笔记本电脑中,绘图时只需绘制每条温度曲线本次采样时刻的温度值与上1次各采样时刻温度值之间的一小段,12个小段都绘完后,立即根据当前屏幕上的时间和温度坐标进行抓图并及时拷贝到Picture控件中,这样在笔记本电脑的屏幕上就可以看到灭菌柜内12个点的实时温度变化曲线。

实时重绘方式并没有进行实际的绘图,不论是在实时绘制方式还是在完全绘制方式下进行实时重绘,温度曲线已经绘制在内存位图中,当屏幕上的温度或时间显示坐标被改变,只需根据当前屏幕上的温度和时间坐标,用BitBlt函数从内存位图中抓取不同的区域拷贝到Picture控件中,其效果就像重绘了这部分温度曲线一样。

实际绘图效果如图3所示,图3也相当于在采样周期为2s,记录了100min的12条温度曲线(3000@12个温度值),实际测试画完并显示不到1s,按动方向键查看曲线其余部分时几乎没有任何滞后。经过分析和实测,用API函数绘制温度曲线速度快的原因如下:

(1)绘图数据从数组获取。一旦启动验证或调入了验证文件,所有温度数据都存于内存中的1个二维数组中而不是存于数据库文件中,在绘制温度曲线时是从内存中读数据而不是从硬盘读数据,这就节约了访问硬盘的时间。

(2)使用画线函数PolyLine。调用画线函数PolyLine1次就可将1条温度曲线完整地画出,而不必象Line方法那样画1条温度曲线要使用很多次Line方法,画图所需的数据事先放在内存中的1个结构数组lpPoint中,调用PolyLine函数时lpPoint数组中的所有元素按传址的方式传递给PolyLine,函数调用时按传址方式传递数组参数的好处是不论数组有多少个元素只把数组第1个元素的地址传递给被调函数,这样大大节约了参数传递的时间。

(3)显示更新时间短。每次绘图后不一定要立即更新显示,只有当所有曲线绘完或显示坐标变化时,才用API函数BitBlt从整个温度曲线(3000@1300像素的大位图)中抓取1个小的局部(850@600像素的较小位图)拷贝的窗体上的Picture控件中,不会频繁更新显示,大量节约了更新显示的时间。

《使用API函数提高VB环境下绘制曲线速度》

Q：请教VB高手一个polyline的问题

Dim a(2001) As Single
    For i = 0 To 2000
        Picture1.Line (i, a(i))-(i + 1, a(i + 1)), vbRed
    Next
上述的一个画线程序,请高手用polyline这个api写一下,我不会用这个API,谢谢啊.

A：

首先是声明：

Declare Function Polyline Lib "gdi32" Alias "Polyline" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long

这里要用到hdc可以用getdc获得，hdc用完后用releasedc释放资源。所以这里还要声名这两个api

Declare Function GetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Long) As Long

Declare Function ReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Long, ByVal hdc As Long) As Long

这里用到一个自定义类型POINTAPI，同样需要声明

type POINTAPI

x as long

y as long

end type

然后就可以调用了。

比如你直接在屏幕上作画，那就这样
dim hdc as long ‘保存句柄用
dim points(3) as POINTAPI ’假设画三角
‘型，三个点存在这个数组里
points(0).x=0
points(0).y=0
points(1).x=100
points(1).y=0
points(2).x=0
points(2).y=100
hdc=getdc(0)'获得句柄

Polyline hdc,points(0),3 '画三角形

'第一个参数表示句柄，第二个参数表示点的数组，第三个参数代表点的个数。

releasedc 0,hdc ’释放句柄

这样就可以了。

AbortPath 抛弃选入指定设备场景中的所有路径。也取消目前正在进行的任何路径的创建工作

AngleArc 用一个连接弧画一条线 Arc 画一个圆弧

BeginPath 启动一个路径分支

CancelDC 取消另一个线程里的长时间绘图操作

Chord 画一个弦

CloseEnhMetaFile 关闭指定的增强型图元文件设备场景，并将新建的图元文件返回一个句柄

CloseFigure 描绘到一个路径时，关闭当前打开的图形

CloseMetaFile 关闭指定的图元文件设备场景，并向新建的图元文件返回一个句柄

CopyEnhMetaFile 制作指定增强型图元文件的一个副本（拷贝）

CopyMetaFile 制作指定（标准）图元文件的一个副本

CreateBrushIndirect 在一个LOGBRUSH数据结构的基础上创建一个刷子

CreateDIBPatternBrush 用一幅与设备无关的位图创建一个刷子，以便指定刷子样式（图案）

CreateEnhMetaFile 创建一个增强型的图元文件设备场景

CreateHatchBrush 创建带有阴影图案的一个刷子

CreateMetaFile 创建一个图元文件设备场景

CreatePatternBrush 用指定了刷子图案的一幅位图创建一个刷子

CreatePen 用指定的样式、宽度和颜色创建一个画笔

CreatePenIndirect 根据指定的LOGPEN结构创建一个画笔

CreateSolidBrush 用纯色创建一个刷子

DeleteEnhMetaFile 删除指定的增强型图元文件

DeleteMetaFile 删除指定的图元文件

DeleteObject 删除GDI对象，对象使用的所有系统资源都会被释放

DrawEdge 用指定的样式描绘一个矩形的边框

DrawEscape 换码（Escape）函数将数据直接发至显示设备驱动程序

DrawFocusRect 画一个焦点矩形

DrawFrameControl 描绘一个标准控件

DrawState 为一幅图象或绘图操作应用各式各样的效果

Ellipse 描绘一个椭圆，由指定的矩形围绕

EndPath 停止定义一个路径

EnumEnhMetaFile 针对一个增强型图元文件，列举其中单独的图元文件记录

EnumMetaFile 为一个标准的windows图元文件枚举单独的图元文件记录

EnumObjects 枚举可随同指定设备场景使用的画笔和刷子

ExtCreatePen 创建一个扩展画笔（装饰或几何）

ExtFloodFill 在指定的设备场景里，用当前选择的刷子填充一个区域

FillPath 关闭路径中任何打开的图形，并用当前刷子填充

FillRect 用指定的刷子填充一个矩形

FlattenPath 将一个路径中的所有曲线都转换成线段

FloodFill 用当前选定的刷子在指定的设备场景中填充一个区域

FrameRect 用指定的刷子围绕一个矩形画一个边框

GdiComment 为指定的增强型图元文件设备场景添加一条注释信息

GdiFlush 执行任何未决的绘图操作

GdiGetBatchLimit 判断有多少个GDI绘图命令位于队列中

GdiSetBatchLimit 指定有多少个GDI绘图命令能够进入队列

GetArcDirection 画圆弧的时候，判断当前采用的绘图方向

GetBkColor 取得指定设备场景当前的背景颜色

GetBkMode 针对指定的设备场景，取得当前的背景填充模式

GetBrushOrgEx 判断指定设备场景中当前选定刷子起点

GetCurrentObject 获得指定类型的当前选定对象

GetCurrentPositionEx 在指定的设备场景中取得当前的画笔位置

GetEnhMetaFile 取得磁盘文件中包含的一个增强型图元文件的图元文件句柄

GetEnhMetaFileBits 将指定的增强型图元文件复制到一个内存缓冲区里

GetEnhMetaFileDescription 返回对一个增强型图元文件的说明

GetEnhMetaFileHeader 取得增强型图元文件的图元文件头

GetEnhMetaFilePaletteEntries 取得增强型图元文件的全部或部分调色板

GetMetaFile 取得包含在一个磁盘文件中的图元文件的图元文件句柄

GetMetaFileBitsEx 将指定的图元文件复制到一个内存缓冲区

GetMiterLimit 取得设备场景的斜率限制（Miter）设置

GetNearestColor 根据设备的显示能力，取得与指定颜色最接近的一种纯色

GetObjectAPI 取得对指定对象进行说明的一个结构

GetObjectType 判断由指定句柄引用的GDI对象的类型

GetPath 取得对当前路径进行定义的一系列数据

GetPixel 在指定的设备场景中取得一个像素的RGB值

GetPolyFillMode 针对指定的设备场景，获得多边形填充模式

GetROP2 针对指定的设备场景，取得当前的绘图模式

GetStockObject 取得一个固有对象（Stock）

GetSysColorBrush 为任何一种标准系统颜色取得一个刷子

GetWinMetaFileBits 通过在一个缓冲区中填充用于标准图元文件的数据，将一个增强型图元文件转换成标准windows图元文件

InvertRect 通过反转每个像素的值，从而反转一个设备场景中指定的矩形

LineDDA 枚举指定线段中的所有点

LineTo 用当前画笔画一条线，从当前位置连到一个指定的点

MoveToEx 为指定的设备场景指定一个新的当前画笔位置

PaintDesktop 在指定的设备场景中描绘桌面墙纸图案

PathToRegion 将当前选定的路径转换到一个区域里 Pie 画一个饼图

PlayEnhMetaFile 在指定的设备场景中画一个增强型图元文件

PlayEnhMetaFileRecord 回放单独一条增强型图元文件记录

PlayMetaFile 在指定的设备场景中回放一个图元文件

PlayMetaFileRecord 回放来自图元文件的单条记录

PolyBezier 描绘一条或多条贝塞尔（Bezier）曲线

PolyDraw 描绘一条复杂的曲线，由线段及贝塞尔曲线组成

Polygon 描绘一个多边形

Polyline 用当前画笔描绘一系列线段

Declare Function Polyline Lib "gdi32" Alias "Polyline" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long

Declare Function PolylineTo Lib "gdi32" Alias "PolylineTo" (ByVal hdc As Long, lppt As POINTAPI, ByVal cCount As Long) As Long

【说明】

用当前画笔描绘一系列线段。使用PolylineTo函数时，当前位置会设为最后一条线段的终点。它不会由Polyline函数改动

【返回值】

Long，非零表示成功，零表示失败

【参数表】

参数	类型及说明
hdc	Long，要在其中绘图的设备场景
lpPoint	pointapi，ncount POINTAPI结构数组中的第一个POINTAPI结构
nCount	Long，lpPoint数组中的点数。会从第一个点到第二个点画一条线，以次类推

http://www.vbgood.com/api-polyline.html

PolyPolygon 用当前选定画笔描绘两个或多个多边形

PolyPolyline 用当前选定画笔描绘两个或多个多边形

Rectangle 用当前选定的画笔描绘矩形，并用当前选定的刷子填充

RoundRect 用当前选定的画笔画一个圆角矩形，并用当前选定的刷子在其中填充

SelectClipPath 将设备场景当前的路径合并到剪切区域里

SelectObject 为当前设备场景选择图形对象

SetArcDirection 设置圆弧的描绘方向

SetBkColor 为指定的设备场景设置背景颜色

SetBkMode 指定阴影刷子、虚线画笔以及字符中的空隙的填充方式

SetBrushOrgEx 为指定的设备场景设置当前选定刷子的起点

SetEnhMetaFileBits 用指定内存缓冲区内包含的数据创建一个增强型图元文件

SetMetaFileBitsEx 用包含在指定内存缓冲区内的数据结构创建一个图元文件

SetMiterLimit 设置设备场景当前的斜率限制

SetPixel 在指定的设备场景中设置一个像素的RGB值

SetPixelV 在指定的设备场景中设置一个像素的RGB值

SetPolyFillMode 设置多边形的填充模式

SetROP2 设置指定设备场景的绘图模式

DrawMode属性完全一致

SetWinMetaFileBits 将一个标准Windows图元文件转换成增强型图元文件

StrokeAndFillPath 针对指定的设备场景，关闭路径上打开的所有区域

StrokePath 用当前画笔描绘一个路径的轮廓。打开的图形不会被这个函数关闭

UnrealizeObject 将一个刷子对象选入设备场景之前，如刷子的起点准备用

SetBrushOrgEx修改，则必须先调用本函数

WidenPath 根据选定画笔的宽度，重新定义当前选定的路径

API函数快速绘图：

当涉及多个参数曲线和大量的数据点的还原显示的时候，VB的函数就显现出速度上的缺陷了，VB在绘图时进行了大量的函数调用，以将模拟坐标的绘图还原到屏幕坐标中。进行简单的测试，大约绘制5个参数，每个参数10000个点，使用VB的Line函数比使用API函数Polyline大约慢50倍以上。样例程序用API重新改写后见样例程序2。

VB函数绘图一般使用的模拟坐标系，而Windows的GDI绘图采用的像素坐标，左上角为（0,0），在调用API前需要对参数进行转换。

由于假设的同时采集多个参数，所以有相同的X坐标点序列，首先初始化绘图点的X值，然后针对不同的参数进行Y坐标的转换，然后调用API进行绘图。

在调用API函数CreatePen时，设置不同的线型参数，可以很容易实现连续线段、不同线形的绘制。通过像素的平移绘制相同的曲线，可以实现线宽大于1的曲线。

图形的缩放和平移：

采集的数据在分析时一般需要进行X轴的放大、缩小和平移。图形的放大平移方法很多，这里仅讨论一下用鼠标滚轮实现这些功能。

按鼠标滚轮的一般使用习惯，滚轮前推，图形向上（向左）平移；滚轮后拉，图形向下（向右）平移。按住Ctrl键，滚轮前推，图形放大；滚轮后拉，图形缩小。

见样例程序3，在窗体的Load子程中通过函数SetWindowLong设置设备消息的回调函数WndProc，该函数放在模块文件中，在回调函数中对消息进行筛选，选取鼠标滚轮消息，再根据传递的滚轮参数值，进行图形的放大或平移等操作。为避免调试时由于设置回调函数造成的VB崩溃，可以自行编制软件判断程序是处于调试状态，此时不加载回调函数的设置。

样例程序2：

Private Type POINTAPI

X As Long

Y As Long

End Type

Private Declare Function Polyline Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount 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 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

Sub DrawData()

Dim i As Long, j As Single, k As Long

Dim tP() As POINTAPI, m As Single, n As Single, tPen As Long, tDC As Long

ReDim tP(CBegin - CEnd)

With DrawObject

n = .ScaleX(1, 0, 3) ‘假设横坐标点是等间隔的，取一个间隔对应的屏幕像素大小

tDC = .hdc

j = 0

k = 0

For i = CBegin To CEnd

tP(k).X = j

j = j + n

k = k + 1

Next i

.ScaleTop = CCoor1

.ScaleHeight = - CCoor1

n = Abs(.ScaleY(CCoor1, 0, 3)) ‘取坐标1对应的像素值

End With

k = 0

j = 0

For i = CBegin To CEnd

‘在循环中，尽量避免调用VB的内部函数，像素点的映射采用自写公式进行计算

tP(k).Y = (1 - CValue1(i) / CCoor1) * n

k = k + 1

Next i

‘创建颜色和线性画笔，参数1设置线性，0为实线；参数2为线宽，这里只能为1；

‘参数3为线的颜色。为实现大于1的线宽，可以采用多次平移像素绘制的方式

tPen = CreatePen(0, 1, CColor1)

SelectObject tDC, tPen

Polyline tDC, tP(0), k

DeleteObject tPen

k = 0

j = 0

For i = CBegin To CEnd

tP(k).Y = (1 – CValue2(i) / CCoor2) * n

k = k + 1

Next i

tPen = CreatePen(0, 1, CColor2)

SelectObject tDC, tPen

Polyline tDC, tP(0), k

DeleteObject tPen

End Sub

样例程序3：

-------------------模块文件程序开始--------------------------------

Public preRWinproc As Long 'frm初始

Public cpWHEELSCROLLLINES As Long '系统返回一个鼠标滚轮滚动的值

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long

Public Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

Public Function WndProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

'Dim wzDelta, wKeys As Integer, pt As POINTAPI

Const WM_DEVICECHANGE = 537

Const WM_MOUSEWHEEL = &H20A

On Error Resume Next

Select Case msg

Case WM_MOUSEWHEEL

frmMain.MouseWheel wParam, lParam

Case Else

WndProc = CallWindowProc(preRWinproc, hwnd, msg, wParam, lParam)

End Select

End Function

-------------------模块文件程序结束--------------------------------

------------------- frmMain窗体程序开始--------------------------------

Private Sub Form_Load()

Dim j As Long

Const GWL_WNDPROC = (-4)

Const SPI_GETWHEELSCROLLLINES = 104

preRWinproc = GetWindowLong(Me.hwnd, GWL_WNDPROC)

j = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WndProc)

Call SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, cpWHEELSCROLLLINES, 0)

cpWHEELSCROLLLINES = cpWHEELSCROLLLINES * 40

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

Dim j As Long

Const GWL_WNDPROC = (-4)

j = SetWindowLong(Me.hwnd, GWL_WNDPROC, preRWinproc)

End Sub

Public Sub MouseWheel(ByVal wParam As Long, ByVal lParam As Long)

Dim wzDelta As Integer, wKeys As Integer, tP As POINTAPI, tX As Long

'一个刻度应该为40，一次3行=120；向前为正，向后为负

wzDelta = HIWORD(wParam)

wzDelta = wzDelta / cpWHEELSCROLLLINES

tP.X = LOWORD(lParam)

tP.Y = HIWORD(lParam)

'Ctrl=8;Shift=4;Alt=Non

wKeys = LOWORD(wParam)

ScreenToClient picMain.hwnd, tP

With picMain ‘绘图对象

tX = .ScaleX(tP.X, 3, 0) + .ScaleLeft

If (tX > CBegin) And (tX < CEnd) And (tP.Y > 0) And (tP.Y < .ScaleY(.ScaleHeight, 0, 3)) Then ‘判断鼠标是否在绘图对象的有效绘图区域内

'设计滚轮向前左移图形，向后右移

'Ctrl向前放大，向后缩小

Select Case wKeys

Case 8

‘此处调用图形放大缩小子程

Case 0

‘此处调用图形平移子程

End Select

End If

End With

End Sub

Private Function HIWORD(LongIn As Long) As Integer

' 取出32位值的高16位

HIWORD = (LongIn And &HFFFF0000) \ &H10000

End Function

Private Function LOWORD(LongIn As Long) As Integer

' 取出32位值的低16位

LOWORD = LongIn And &HFFFF&

End Function

------------------- frmMain窗体程序结束--------------------------------

yiyiyicz

关注

0
点赞
踩
1

收藏

觉得还不错? 一键收藏
0
评论
网摘》用Picture、API绘图

Picture1.Autoredraw=True 画好的图就不会被抹掉。只有设置为true，才可以在图片框内绘制曲线 Q：根据一组坐标在picture上面画一条线（没有规律），用picture.line方法绘制。当想选中这条线，然后更改这条线的样式，，然后鼠标右键删除。现在是无法选中这条线，，，各位达人有没有好的解决办？A：第一种办法：不直接使用VB的line命令，而是使用API函数L
复制链接

扫一扫

专栏目录