1,488
社区成员
发帖
与我相关
我的任务
分享绘图场景使用时输出变形问题以及Cpu 100％
我想用绘图场景实现无闪烁的实时曲线显示
功能基本完成
但是发现绘图的比例无端增大了，跟踪过绘图比例值，都是正确的，但是输出却有问题。
另外，用绘图场景＋api的bitblt是不是很耗cpu？ 基本开始绘图都是100％
而且严重影响程序运行
功能基本完成
但是发现绘图的比例无端增大了，跟踪过绘图比例值，都是正确的，但是输出却有问题。
另外，用绘图场景＋api的bitblt是不是很耗cpu？ 基本开始绘图都是100％
而且严重影响程序运行
...全文
请发表友善的回复…
发表回复
James0001 2004-07-28
- 打赏
- 举报
另外有没有在设备场景中创建画笔后设置画笔颜色的api函数啊？
----------------------------------
你是指SetDCPenColor啊？
declare function SetDCPenColor lib "gdi32" (byval hdc as long, byval crColor as long) as long
设置设备场景画笔的颜色。
hdc - 设备场景
crColor - 新的画笔颜色
返回旧的画笔颜色。
使用前将 GetStockObject(DC_PEN) 选入设备场景。
如 oldPen = SelectObject( hdc, GetStockObject(DC_PEN) ):SetDCPenColor hdc,vbblue
在win2000及以上系统中有效。
SetDCBrushColor 的使用方法类似
DC_BRUSH = 18
DC_PEN = 19
----------------------------------
你是指SetDCPenColor啊？
declare function SetDCPenColor lib "gdi32" (byval hdc as long, byval crColor as long) as long
设置设备场景画笔的颜色。
hdc - 设备场景
crColor - 新的画笔颜色
返回旧的画笔颜色。
使用前将 GetStockObject(DC_PEN) 选入设备场景。
如 oldPen = SelectObject( hdc, GetStockObject(DC_PEN) ):SetDCPenColor hdc,vbblue
在win2000及以上系统中有效。
SetDCBrushColor 的使用方法类似
DC_BRUSH = 18
DC_PEN = 19
zyl910 2004-07-27
- 打赏
- 举报
代码太多了，一时找不出问题
另外有没有在设备场景中创建画笔后设置画笔颜色的api函数啊？
----------------------------------
没有
但是用GetStockObject可以得到固有的GDI对象
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 白色画笔
ANSI_FIXED_FONT 采用windows（ANSI）字符集的等宽字体 ANSI_VAR_FONT 采用windows（ANSI）字符集的不等宽字体
DEVICE_DEFAULT_FONT 设备使用的默认字体（NT） DEFAULT_GUI_FONT 用户界面的默认字体，包括菜单和对话框字体（Windows 95）
OEM_FIXED_FONT OEM字符集的固有字体 SYSTEM_FONT 屏幕系统字体。这是用于菜单、对话框等等的默认不等宽字体
SYSTEM_FIXED_FONT 屏幕系统字体。这是用于菜单、对话框等等的默认等宽字体（在windows 3.0之前使用） DEFAULT_PALETTE 默认调色板
注解
固有刷子的起点可能不会改变。不应用DeleteObject函数删除这些对象。不要对那些不具备CS_HREDRAW 和 CS_VREDRAW类样式的窗口使用DK_GRAY_BRUSH，GRAY_BRUSH 和 LTGRAY_BRUSH刷子
另外有没有在设备场景中创建画笔后设置画笔颜色的api函数啊？
----------------------------------
没有
但是用GetStockObject可以得到固有的GDI对象
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 白色画笔
ANSI_FIXED_FONT 采用windows（ANSI）字符集的等宽字体 ANSI_VAR_FONT 采用windows（ANSI）字符集的不等宽字体
DEVICE_DEFAULT_FONT 设备使用的默认字体（NT） DEFAULT_GUI_FONT 用户界面的默认字体，包括菜单和对话框字体（Windows 95）
OEM_FIXED_FONT OEM字符集的固有字体 SYSTEM_FONT 屏幕系统字体。这是用于菜单、对话框等等的默认不等宽字体
SYSTEM_FIXED_FONT 屏幕系统字体。这是用于菜单、对话框等等的默认等宽字体（在windows 3.0之前使用） DEFAULT_PALETTE 默认调色板
注解
固有刷子的起点可能不会改变。不应用DeleteObject函数删除这些对象。不要对那些不具备CS_HREDRAW 和 CS_VREDRAW类样式的窗口使用DK_GRAY_BRUSH，GRAY_BRUSH 和 LTGRAY_BRUSH刷子
dyingtree 2004-07-27
- 打赏
- 举报
经过一天对比研究，突然发现，问题在控件设计上
尽管在属性框中显示picturebox的scaleheight＝450
但是实际上却只有420
因此在画图时，设备场景用450的高度来画，却只能显示在420高度的picturebox中
造成了变形
估计是vb的一个bug，属性框中尽管修改成450，但实际上却没有修改
关于cpu的使用，由于我每画一段就创建一个新的画笔（因为颜色不同），又没有及时把用过的画笔删掉，这个问题在我及时删除对象后基本解决了。
另外有没有在设备场景中创建画笔后设置画笔颜色的api函数啊？
尽管在属性框中显示picturebox的scaleheight＝450
但是实际上却只有420
因此在画图时，设备场景用450的高度来画，却只能显示在420高度的picturebox中
造成了变形
估计是vb的一个bug，属性框中尽管修改成450，但实际上却没有修改
关于cpu的使用，由于我每画一段就创建一个新的画笔（因为颜色不同），又没有及时把用过的画笔删掉，这个问题在我及时删除对象后基本解决了。
另外有没有在设备场景中创建画笔后设置画笔颜色的api函数啊？
dyingtree 2004-07-27
- 打赏
- 举报
Option Explicit
Private HMemDC As Long '实时的设备场景
Private HBakDC As Long '移动前的原设备场景
Private HOutDC As Long '与picture1绑定的最后输出设备场景
Private hBrush As Long '刷子
Private XUnitLen As Single 'x轴的单元长度
Private YUnitLen As Single 'y轴的单元长度
Private PrevY As Long '原先的y值
Private R As RECT '记录picture1坐标的方框
Private prevyarray(6) As Long '记录六条曲线的先前的值
Private nWidth As Long '记录picture1的宽度
Private nHeight As Long '记录picture1的高度
Private hObject As Long '创建对象用的临时变量
Private i As Integer, j As Integer '公用计数用
Private prevpoint As POINTAPI '记录画笔的前一个坐标点
Public Sub SetView(ByVal lhOutDC As Long, _
ByVal nWidth As Single, _
ByVal nHeight As Single, _
ByVal nXUnits As Single, _
ByVal nYUnits As Single)
'**************初始化设备场景
HOutDC = lhOutDC 'lhoutdc 传入picture1的设备场景
R.Left = 0
R.Top = 0
R.Bottom = nHeight
R.Right = nWidth
XUnitLen = nXUnits 'nXUnits＝picture1.scalewidth/每屏要画的数据点数
YUnitLen = nYUnits 'nYUnits＝picture1.scaleheight/选定数据集的y_max－y_min
HMemDC = CreateCompatibleDC(HOutDC) '创建设备场景
HBakDC = CreateCompatibleDC(HOutDC)
hBrush = CreateSolidBrush(vbBlack) '创建刷子并涂黑
FillRect HMemDC, R, hBrush
hObject = CreatePen(0, 1, RGB(77, 77, 77)) '创建画笔
'画网格，y轴均分5分，画4条，x轴按每屏要画的数据点数
For i = 1 To 4
MoveToEx HMemDC, 0, CLng(nHeight / 5 * i), prevpoint
LineTo HMemDC, CLng(nWidth), CLng(nHeight / 5 * i)
Next i
For i = 1 To CInt(nWidth / XUnitLen)
MoveToEx HMemDC, CLng(XUnitLen * i), 0, prevpoint
LineTo HMemDC, CLng(XUnitLen * i), CLng(nHeight)
Next i
BitBlt HOutDC, 0, 0, nWidth, nHeight, HMemDC, 0, 0, vbSrcCopy '将处理后的设备场景输出
End Sub
Public Sub move()
Dim j As Integer
nWidth = R.Right
nHeight = R.Bottom
BitBlt HBakDC, 0, 0, nWidth, nHeight, HMemDC, 0, 0, vbSrcCopy '先拷贝移动前的设备场景
FillRect HMemDC, R, hBrush
hObject = CreatePen(0, 1, RGB(77, 77, 77)) '将背景涂黑
'画网格
For i = 1 To 4
MoveToEx HMemDC, 0, CLng(nHeight / 5 * i), prevpoint
LineTo HMemDC, CLng(nWidth), CLng(nHeight / 5 * i)
Next i
For i = 1 To CInt(nWidth / XUnitLen)
MoveToEx HMemDC, CLng(XUnitLen * i), 0, prevpoint
LineTo HMemDC, CLng(XUnitLen * i), CLng(nHeight)
Next i
'向左退移1个单位
BitBlt HMemDC, 0, 0, nWidth, nHeight, HBakDC, XUnitLen, 0, vbSrcCopy '将移动前的设备场景作为源输出到当前设备场景
End Sub
Public Sub DrawCurve(ByVal ny As Single, ByVal color As Long)
'画新的曲线，根据传入的一个y值和颜色，选择相应的曲线画图
PrevY = ny
Select Case color
Case RGB(255, 255, 255)
hObject = CreatePen(0, 2, color)
MoveToEx HMemDC, nWidth - XUnitLen, nHeight - prevyarray(1), prevpoint
LineTo HMemDC, nWidth, nHeight - PrevY
prevyarray(1) = PrevY
Case RGB(255, 255, 0)
hObject = CreatePen(0, 2, color)
MoveToEx HMemDC, nWidth - XUnitLen, nHeight - prevyarray(2), prevpoint
LineTo HMemDC, nWidth, nHeight - PrevY
prevyarray(2) = PrevY
Case RGB(255, 0, 0)
hObject = CreatePen(0, 2, color)
MoveToEx HMemDC, nWidth - XUnitLen, nHeight - prevyarray(3), prevpoint
LineTo HMemDC, nWidth, nHeight - PrevY
prevyarray(3) = PrevY
Case RGB(0, 255, 0)
hObject = CreatePen(0, 2, color)
MoveToEx HMemDC, nWidth - XUnitLen, nHeight - prevyarray(4), prevpoint
LineTo HMemDC, nWidth, nHeight - PrevY
prevyarray(4) = PrevY
Case RGB(0, 0, 255)
hObject = CreatePen(0, 2, color)
MoveToEx HMemDC, nWidth - XUnitLen, nHeight - prevyarray(5), prevpoint
LineTo HMemDC, nWidth, nHeight - PrevY
prevyarray(5) = PrevY
Case RGB(255, 0, 255)
hObject = CreatePen(0, 2, color)
MoveToEx HMemDC, nWidth - XUnitLen, nHeight - prevyarray(6), prevpoint
LineTo HMemDC, nWidth, nHeight - PrevY
prevyarray(6) = PrevY
End Select
'输出结果
BitBlt HOutDC, 0, 0, nWidth, nHeight, HMemDC, 0, 0, vbSrcCopy
End Sub
Public Property Get hdc() As Long
hdc = HMemDC
End Property
Private HMemDC As Long '实时的设备场景
Private HBakDC As Long '移动前的原设备场景
Private HOutDC As Long '与picture1绑定的最后输出设备场景
Private hBrush As Long '刷子
Private XUnitLen As Single 'x轴的单元长度
Private YUnitLen As Single 'y轴的单元长度
Private PrevY As Long '原先的y值
Private R As RECT '记录picture1坐标的方框
Private prevyarray(6) As Long '记录六条曲线的先前的值
Private nWidth As Long '记录picture1的宽度
Private nHeight As Long '记录picture1的高度
Private hObject As Long '创建对象用的临时变量
Private i As Integer, j As Integer '公用计数用
Private prevpoint As POINTAPI '记录画笔的前一个坐标点
Public Sub SetView(ByVal lhOutDC As Long, _
ByVal nWidth As Single, _
ByVal nHeight As Single, _
ByVal nXUnits As Single, _
ByVal nYUnits As Single)
'**************初始化设备场景
HOutDC = lhOutDC 'lhoutdc 传入picture1的设备场景
R.Left = 0
R.Top = 0
R.Bottom = nHeight
R.Right = nWidth
XUnitLen = nXUnits 'nXUnits＝picture1.scalewidth/每屏要画的数据点数
YUnitLen = nYUnits 'nYUnits＝picture1.scaleheight/选定数据集的y_max－y_min
HMemDC = CreateCompatibleDC(HOutDC) '创建设备场景
HBakDC = CreateCompatibleDC(HOutDC)
hBrush = CreateSolidBrush(vbBlack) '创建刷子并涂黑
FillRect HMemDC, R, hBrush
hObject = CreatePen(0, 1, RGB(77, 77, 77)) '创建画笔
'画网格，y轴均分5分，画4条，x轴按每屏要画的数据点数
For i = 1 To 4
MoveToEx HMemDC, 0, CLng(nHeight / 5 * i), prevpoint
LineTo HMemDC, CLng(nWidth), CLng(nHeight / 5 * i)
Next i
For i = 1 To CInt(nWidth / XUnitLen)
MoveToEx HMemDC, CLng(XUnitLen * i), 0, prevpoint
LineTo HMemDC, CLng(XUnitLen * i), CLng(nHeight)
Next i
BitBlt HOutDC, 0, 0, nWidth, nHeight, HMemDC, 0, 0, vbSrcCopy '将处理后的设备场景输出
End Sub
Public Sub move()
Dim j As Integer
nWidth = R.Right
nHeight = R.Bottom
BitBlt HBakDC, 0, 0, nWidth, nHeight, HMemDC, 0, 0, vbSrcCopy '先拷贝移动前的设备场景
FillRect HMemDC, R, hBrush
hObject = CreatePen(0, 1, RGB(77, 77, 77)) '将背景涂黑
'画网格
For i = 1 To 4
MoveToEx HMemDC, 0, CLng(nHeight / 5 * i), prevpoint
LineTo HMemDC, CLng(nWidth), CLng(nHeight / 5 * i)
Next i
For i = 1 To CInt(nWidth / XUnitLen)
MoveToEx HMemDC, CLng(XUnitLen * i), 0, prevpoint
LineTo HMemDC, CLng(XUnitLen * i), CLng(nHeight)
Next i
'向左退移1个单位
BitBlt HMemDC, 0, 0, nWidth, nHeight, HBakDC, XUnitLen, 0, vbSrcCopy '将移动前的设备场景作为源输出到当前设备场景
End Sub
Public Sub DrawCurve(ByVal ny As Single, ByVal color As Long)
'画新的曲线，根据传入的一个y值和颜色，选择相应的曲线画图
PrevY = ny
Select Case color
Case RGB(255, 255, 255)
hObject = CreatePen(0, 2, color)
MoveToEx HMemDC, nWidth - XUnitLen, nHeight - prevyarray(1), prevpoint
LineTo HMemDC, nWidth, nHeight - PrevY
prevyarray(1) = PrevY
Case RGB(255, 255, 0)
hObject = CreatePen(0, 2, color)
MoveToEx HMemDC, nWidth - XUnitLen, nHeight - prevyarray(2), prevpoint
LineTo HMemDC, nWidth, nHeight - PrevY
prevyarray(2) = PrevY
Case RGB(255, 0, 0)
hObject = CreatePen(0, 2, color)
MoveToEx HMemDC, nWidth - XUnitLen, nHeight - prevyarray(3), prevpoint
LineTo HMemDC, nWidth, nHeight - PrevY
prevyarray(3) = PrevY
Case RGB(0, 255, 0)
hObject = CreatePen(0, 2, color)
MoveToEx HMemDC, nWidth - XUnitLen, nHeight - prevyarray(4), prevpoint
LineTo HMemDC, nWidth, nHeight - PrevY
prevyarray(4) = PrevY
Case RGB(0, 0, 255)
hObject = CreatePen(0, 2, color)
MoveToEx HMemDC, nWidth - XUnitLen, nHeight - prevyarray(5), prevpoint
LineTo HMemDC, nWidth, nHeight - PrevY
prevyarray(5) = PrevY
Case RGB(255, 0, 255)
hObject = CreatePen(0, 2, color)
MoveToEx HMemDC, nWidth - XUnitLen, nHeight - prevyarray(6), prevpoint
LineTo HMemDC, nWidth, nHeight - PrevY
prevyarray(6) = PrevY
End Select
'输出结果
BitBlt HOutDC, 0, 0, nWidth, nHeight, HMemDC, 0, 0, vbSrcCopy
End Sub
Public Property Get hdc() As Long
hdc = HMemDC
End Property
zyl910 2004-07-26
- 打赏
- 举报
将完整的代码贴出来看看
dyingtree 2004-07-26
- 打赏
- 举报
绘图频率在10ms
刚开机的时候，可以很顺利的进行，但是运行多次后，会出现迟滞现象，10ms的绘图速度大概降到100ms，另外鼠标移动开始困难，vb整个程序也开始出现问题，主要是画面上，好像死机的样子。
在我退出vb后，这种现象还是不能缓解，是不是我还有很多绘图场景占用的内存没有释放？
另外横线间隔变大是怎么回事？
zyl910 2004-07-26
- 打赏
- 举报
是你绘图的频率太快
CPU占用率的意义是单位时间内切换到非零页线程时间的百分比
也就是CPU占用率只是宏观概念
从微观来看，只要程序在运行，CPU占用率绝对是100%
CPU占用率的意义是单位时间内切换到非零页线程时间的百分比
也就是CPU占用率只是宏观概念
从微观来看，只要程序在运行，CPU占用率绝对是100%
dyingtree 2004-07-26
- 打赏
- 举报
我想用绘图场景实现无闪烁的实时曲线显示
功能基本完成
但是发现绘图的比例无端增大了，跟踪过绘图比例值，都是正确的，但是输出却有问题。
表现在横线方向的比例增大，即横线间距增大
'画5条水平横线 ，nheight、nwidth为picturebox的scaleheight，scalewidth
For i = 1 To 5
MoveToEx HMemDC, 0, CLng(nHeight / 5 * i), prevpoint
LineTo HMemDC, CLng(nWidth), CLng(nHeight / 5 * i)
Next i
'画纵线，xunitlen为每条纵线之间的像素点的个数
For i = 1 To CInt(nWidth / XUnitLen)
MoveToEx HMemDC, CLng(XUnitLen * i), 0, prevpoint
LineTo HMemDC, CLng(XUnitLen * i), CLng(nHeight)
Next i
BitBlt HOutDC, 0, 0, nWidth, nHeight, HMemDC, 0, 0, vbSrcCopy
是不是只有可能是我的编程上的问题？
另外，用绘图场景＋api的bitblt是不是很耗cpu？ 基本开始绘图都是100％
而且严重影响程序运行
画完后我已经使用deleteobject 把创建的画笔，刷子什么的都删掉了
功能基本完成
但是发现绘图的比例无端增大了，跟踪过绘图比例值，都是正确的，但是输出却有问题。
表现在横线方向的比例增大，即横线间距增大
'画5条水平横线 ，nheight、nwidth为picturebox的scaleheight，scalewidth
For i = 1 To 5
MoveToEx HMemDC, 0, CLng(nHeight / 5 * i), prevpoint
LineTo HMemDC, CLng(nWidth), CLng(nHeight / 5 * i)
Next i
'画纵线，xunitlen为每条纵线之间的像素点的个数
For i = 1 To CInt(nWidth / XUnitLen)
MoveToEx HMemDC, CLng(XUnitLen * i), 0, prevpoint
LineTo HMemDC, CLng(XUnitLen * i), CLng(nHeight)
Next i
BitBlt HOutDC, 0, 0, nWidth, nHeight, HMemDC, 0, 0, vbSrcCopy
是不是只有可能是我的编程上的问题？
另外，用绘图场景＋api的bitblt是不是很耗cpu？ 基本开始绘图都是100％
而且严重影响程序运行
画完后我已经使用deleteobject 把创建的画笔，刷子什么的都删掉了
