7,763
社区成员
发帖
与我相关
我的任务
分享自动改变油的高度
各和高手请帮我写一段代码,我不会写,在线等待.
我给公司开发一个油罐保税系统:当油的体积,油温度,油位,重量变化时,有个油罐形里的油也要起相应的变化.如:油罐内的油用黄颜色表式,油的高度由1米上升到3米,黄颜色部分也由1米的地方添冲到３米的地方.．
我给公司开发一个油罐保税系统:当油的体积,油温度,油位,重量变化时,有个油罐形里的油也要起相应的变化.如:油罐内的油用黄颜色表式,油的高度由1米上升到3米,黄颜色部分也由1米的地方添冲到３米的地方.．
...全文
请发表友善的回复…
发表回复
dandelionl 2004-07-14
- 打赏
- 举报
KiteGirl(小仙妹) 已经是超级好人了！
KiteGirl 2004-07-13
- 打赏
- 举报
假如：你当地的油位置最高是3000mm，温度可测值最高120度，警戒值为80度（千万不要设置为最大测量极限，一定留个余地，否则警告功能无效）、最低可测值-40度，警戒值20度。
Private Sub Form_Load()
ctlOliCask1.Max = 3000
ctlOliCask1.TemperatureMax = 80
ctlOliCask1.TemperatureMin = 20
ctlOliCask1.IconEnabled = True
End Sub
当你想在某程序当中显示油的状态。假如油温度是变量T，而油的高度是变量V。则：
ctlOliCask1.Value = V
ctlOliCask1.Temperature = T
这样，立刻就会在该控件显示油的状态。
再比如：你当地的油不以油位为准，而是重量。重量最高是3000kg，空桶重500kg，温度可测值最高120度，警戒值为80度、最低可测值-40度，警戒值20度。
Private Sub Form_Load()
ctlOliCask1.Max = 3000 - 500
ctlOliCask1.TemperatureMax = 80
ctlOliCask1.TemperatureMin = 20
ctlOliCask1.IconEnabled = True
End Sub
当你想在某程序当中显示油的状态。假如油温度是变量T，而油的重量是变量V。则：
ctlOliCask1.Value = V - 500
ctlOliCask1.Temperature = T
假如你的系统中油位置最高极限是3500，而实际上用到的值最高为3000，那么留500作为余地。假如读数为3000，则显示FL标记，而超过这个值到了3010，则显示VH标记。
同样道理，如果温度低于下限或高于下限，将分别显示TL和TH标记。
Private Sub Form_Load()
ctlOliCask1.Max = 3000
ctlOliCask1.TemperatureMax = 80
ctlOliCask1.TemperatureMin = 20
ctlOliCask1.IconEnabled = True
End Sub
当你想在某程序当中显示油的状态。假如油温度是变量T，而油的高度是变量V。则：
ctlOliCask1.Value = V
ctlOliCask1.Temperature = T
这样，立刻就会在该控件显示油的状态。
再比如：你当地的油不以油位为准，而是重量。重量最高是3000kg，空桶重500kg，温度可测值最高120度，警戒值为80度、最低可测值-40度，警戒值20度。
Private Sub Form_Load()
ctlOliCask1.Max = 3000 - 500
ctlOliCask1.TemperatureMax = 80
ctlOliCask1.TemperatureMin = 20
ctlOliCask1.IconEnabled = True
End Sub
当你想在某程序当中显示油的状态。假如油温度是变量T，而油的重量是变量V。则：
ctlOliCask1.Value = V - 500
ctlOliCask1.Temperature = T
假如你的系统中油位置最高极限是3500，而实际上用到的值最高为3000，那么留500作为余地。假如读数为3000，则显示FL标记，而超过这个值到了3010，则显示VH标记。
同样道理，如果温度低于下限或高于下限，将分别显示TL和TH标记。
KiteGirl 2004-07-13
- 打赏
- 举报
http://smallfairy.51.net/KiteGirl/OliCask.zip
将ctlOliCask.ctl拷贝到你工程目录下。然后打开你的工程：
1、在“工程>添加类模块>现存”下，选择ctlOliCask.ctl文件。这时候，工具栏会出现一个新的，叫做ctlOliCask的控件。
2、将一个ctlOliCask控件放到你需要的窗体位置上，拉到多大都可以。默认名字可能是ctlOliCask1。
3、在你窗体的Load事件下输入：
Private Sub Form_Load()
ctlOliCask1.Max = 油位上限 '默认100。就是你所取的油位的最大可能的值。
ctlOliCask1.TemperatureMax = 温度上限 '默认100度。就是油的温度的最大可能值。
ctlOliCask1.TemperatureMin = 温度下限 '默认-40度。就是油的温度的最下可能值。
ctlOliCask1.IconEnabled = '如果想显示警告标志就设置为True，否则不用设置。
End Sub
4、获得你需要的油位数据、温度数据。这个是你的事情了。
5、在适当的程序位置使ctlOliCask1显示你需要的油位，具体是这样的：
ctlOliCask1.value = 油的位置
ctlOliCask1.Temperature = 油的温度（如果没有温度数据，设置为0也可以。只要不小于ctlOliCask1.TemperatureMin就不会出现警告）
将ctlOliCask.ctl拷贝到你工程目录下。然后打开你的工程：
1、在“工程>添加类模块>现存”下，选择ctlOliCask.ctl文件。这时候，工具栏会出现一个新的，叫做ctlOliCask的控件。
2、将一个ctlOliCask控件放到你需要的窗体位置上，拉到多大都可以。默认名字可能是ctlOliCask1。
3、在你窗体的Load事件下输入：
Private Sub Form_Load()
ctlOliCask1.Max = 油位上限 '默认100。就是你所取的油位的最大可能的值。
ctlOliCask1.TemperatureMax = 温度上限 '默认100度。就是油的温度的最大可能值。
ctlOliCask1.TemperatureMin = 温度下限 '默认-40度。就是油的温度的最下可能值。
ctlOliCask1.IconEnabled = '如果想显示警告标志就设置为True，否则不用设置。
End Sub
4、获得你需要的油位数据、温度数据。这个是你的事情了。
5、在适当的程序位置使ctlOliCask1显示你需要的油位，具体是这样的：
ctlOliCask1.value = 油的位置
ctlOliCask1.Temperature = 油的温度（如果没有温度数据，设置为0也可以。只要不小于ctlOliCask1.TemperatureMin就不会出现警告）
jumay 2004-07-13
- 打赏
- 举报
小仙妹妹
我还是看不懂,把你的EMAIL告诉我,我把原程序和数据库发给你,请你帮忙完成这个功能.我的邮箱是myjumay@163.com.
谢谢,今天是这个功能完成的最后一天,下午老总就要过来看了,我很急的,帮帮我好吗?
我还是看不懂,把你的EMAIL告诉我,我把原程序和数据库发给你,请你帮忙完成这个功能.我的邮箱是myjumay@163.com.
谢谢,今天是这个功能完成的最后一天,下午老总就要过来看了,我很急的,帮帮我好吗?
jumay 2004-07-13
- 打赏
- 举报
小仙妹妹
我按你的方法去做还是不行,你能不能帮我完成这个模块,我实在是没有办法了,告诉我邮件地址好吗?
我按你的方法去做还是不行,你能不能帮我完成这个模块,我实在是没有办法了,告诉我邮件地址好吗?
KiteGirl 2004-07-12
- 打赏
- 举报
Form文件：frmOilCask_Test.frm 这个是测试代码。
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 4665
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 4665
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin VB.HScrollBar HScroll2
Height = 255
Left = 120
Max = 100
Min = -40
TabIndex = 3
Top = 3000
Width = 4455
End
Begin VB.HScrollBar HScroll1
Height = 255
Left = 120
Max = 100
TabIndex = 2
Top = 2640
Width = 4455
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 375
Left = 3240
TabIndex = 1
Top = 3840
Width = 1335
End
Begin VB.PictureBox Picture1
Height = 2415
Left = 120
ScaleHeight = 2355
ScaleWidth = 435
TabIndex = 0
Top = 120
Width = 495
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub HScroll1_Change()
Dim tOli As Double
Dim tTMP As Double
tOli = HScroll1.Value
tTMP = HScroll2.Value
OliTagDraw Picture1, tOli, 100, tTMP
End Sub
Private Sub HScroll2_Change()
Dim tOli As Double
Dim tTMP As Double
tOli = HScroll1.Value
tTMP = HScroll2.Value
OliTagDraw Picture1, tOli, 100, tTMP
End Sub
modOliCask.bas文件：以下是画油位的关键函数。但我并没有写成控件，它只是一个绘制油位的程序而已。有时间或许会帮你做一个简单控件出来。本来想做一个带警戒功能的，但时间不大够了。
Public Sub OliTagDraw(ByRef pPictureBox As PictureBox, ByVal pOliTag As Double, ByVal pOliTagMax As Double, ByVal pTMP As Double, Optional ByVal pTMP_Max As Double = 100, Optional ByVal pTMP_Min As Double = -40)
'参数：pPictureBox 需要显示油量指示的图片框。pPictureBox的大小不限制，因为本函数自动适应图片框的尺寸。
' pOliTag 油的位置（也可以是重量）,必须在0到pOliTagMax之间。
' pOliTagMax 最高油位（就是油装满油桶的位置，也可以是最大重量）默认为100
' pTMP 油的温度，根据温度决定显示油的颜色。必须在pTMP_Min和pTMP_Max之间。
' pTMP_Max 油温度的最高极限。
' pTMP_Min 油温度的最低极限。
Dim tDesHeight As Double
Dim tTMP_Bound As Double
Dim tTMP_Value As Double
Dim tColorLevel As Long
Dim tColor As Long
tTMP_Bound = pTMP_Max - pTMP_Min
tTMP_Value = pTMP - pTMP_Min
If tTMP_Value >= 0 And tTMP_Value <= tTMP_Bound Then
tColorLevel = (255 - ((tTMP_Value * 255) / tTMP_Bound))
tColor = tColorLevel * &H100 + &HFF
Else
tColor = &HFFFFFF
End If
With pPictureBox
tDesHeight = .Height - ((pOliTag * .Height) / pOliTagMax)
pPictureBox.Line (0, tDesHeight)-(.Width, .Height), tColor, BF
pPictureBox.Line (0, 0)-(.Width, tDesHeight), &H808080, BF
End With
End Sub
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 4665
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 4665
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin VB.HScrollBar HScroll2
Height = 255
Left = 120
Max = 100
Min = -40
TabIndex = 3
Top = 3000
Width = 4455
End
Begin VB.HScrollBar HScroll1
Height = 255
Left = 120
Max = 100
TabIndex = 2
Top = 2640
Width = 4455
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 375
Left = 3240
TabIndex = 1
Top = 3840
Width = 1335
End
Begin VB.PictureBox Picture1
Height = 2415
Left = 120
ScaleHeight = 2355
ScaleWidth = 435
TabIndex = 0
Top = 120
Width = 495
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub HScroll1_Change()
Dim tOli As Double
Dim tTMP As Double
tOli = HScroll1.Value
tTMP = HScroll2.Value
OliTagDraw Picture1, tOli, 100, tTMP
End Sub
Private Sub HScroll2_Change()
Dim tOli As Double
Dim tTMP As Double
tOli = HScroll1.Value
tTMP = HScroll2.Value
OliTagDraw Picture1, tOli, 100, tTMP
End Sub
modOliCask.bas文件：以下是画油位的关键函数。但我并没有写成控件，它只是一个绘制油位的程序而已。有时间或许会帮你做一个简单控件出来。本来想做一个带警戒功能的，但时间不大够了。
Public Sub OliTagDraw(ByRef pPictureBox As PictureBox, ByVal pOliTag As Double, ByVal pOliTagMax As Double, ByVal pTMP As Double, Optional ByVal pTMP_Max As Double = 100, Optional ByVal pTMP_Min As Double = -40)
'参数：pPictureBox 需要显示油量指示的图片框。pPictureBox的大小不限制，因为本函数自动适应图片框的尺寸。
' pOliTag 油的位置（也可以是重量）,必须在0到pOliTagMax之间。
' pOliTagMax 最高油位（就是油装满油桶的位置，也可以是最大重量）默认为100
' pTMP 油的温度，根据温度决定显示油的颜色。必须在pTMP_Min和pTMP_Max之间。
' pTMP_Max 油温度的最高极限。
' pTMP_Min 油温度的最低极限。
Dim tDesHeight As Double
Dim tTMP_Bound As Double
Dim tTMP_Value As Double
Dim tColorLevel As Long
Dim tColor As Long
tTMP_Bound = pTMP_Max - pTMP_Min
tTMP_Value = pTMP - pTMP_Min
If tTMP_Value >= 0 And tTMP_Value <= tTMP_Bound Then
tColorLevel = (255 - ((tTMP_Value * 255) / tTMP_Bound))
tColor = tColorLevel * &H100 + &HFF
Else
tColor = &HFFFFFF
End If
With pPictureBox
tDesHeight = .Height - ((pOliTag * .Height) / pOliTagMax)
pPictureBox.Line (0, tDesHeight)-(.Width, .Height), tColor, BF
pPictureBox.Line (0, 0)-(.Width, tDesHeight), &H808080, BF
End With
End Sub
jumay 2004-07-12
- 打赏
- 举报
小仙妹妹,我是个初学者,能不能把代码写全,公司要我开发这个系统,我很急的.
jumay 2004-07-12
- 打赏
- 举报
请问狼行天下
Picture1和Vscrll1,是什么?要怎样才能定义他们
Picture1和Vscrll1,是什么?要怎样才能定义他们
Mars.CN 2004-07-12
- 打赏
- 举报
有控制硬件吗？
看者不象呀？
到底是什么东西呀？
看者不象呀？
到底是什么东西呀？
ryuginka 2004-07-12
- 打赏
- 举报
up
KiteGirl 2004-07-12
- 打赏
- 举报
'最新测试代码的frm文件内容：
'（演示了ctlOliCask在油位超高、温度过高或过低情况下的警告标记状态）
'如果用传感器捕捉油桶的重量，并且事先得知油桶满载的重量。那么，你只要设置ctlOliCask的Max为油桶满载重量，再将油桶重量交给Value属性就可以显示油位。因为油位和重量是直线对应的。如果以传感器捕捉油桶的温度，甚至可以监视油桶的温度变化。但本程序乃至Windows不是专为这种重要场合设计的，这个程序是否可靠目前还不好估计。
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 4665
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 4665
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin 工程1.ctlOliCask ctlOliCask1
Height = 2055
Left = 120
TabIndex = 3
Top = 240
Width = 615
_extentx = 873
_extenty = 3413
End
Begin VB.HScrollBar HScroll2
Height = 255
Left = 120
Max = 200
Min = -100
TabIndex = 2
Top = 3000
Width = 4455
End
Begin VB.HScrollBar HScroll1
Height = 255
Left = 120
Max = 200
Min = -20
TabIndex = 1
Top = 2640
Width = 4455
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 375
Left = 3240
TabIndex = 0
Top = 3840
Width = 1335
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub HScroll1_Change()
Dim tOli As Double
Dim tTMP As Double
tOli = HScroll1.Value
tTMP = HScroll2.Value
ctlOliCask1.Value = tOli
ctlOliCask1.Temperature = tTMP
End Sub
Private Sub HScroll2_Change()
Dim tOli As Double
Dim tTMP As Double
tOli = HScroll1.Value
tTMP = HScroll2.Value
ctlOliCask1.Value = tOli
ctlOliCask1.Temperature = tTMP
End Sub
'（演示了ctlOliCask在油位超高、温度过高或过低情况下的警告标记状态）
'如果用传感器捕捉油桶的重量，并且事先得知油桶满载的重量。那么，你只要设置ctlOliCask的Max为油桶满载重量，再将油桶重量交给Value属性就可以显示油位。因为油位和重量是直线对应的。如果以传感器捕捉油桶的温度，甚至可以监视油桶的温度变化。但本程序乃至Windows不是专为这种重要场合设计的，这个程序是否可靠目前还不好估计。
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 4665
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 4665
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin 工程1.ctlOliCask ctlOliCask1
Height = 2055
Left = 120
TabIndex = 3
Top = 240
Width = 615
_extentx = 873
_extenty = 3413
End
Begin VB.HScrollBar HScroll2
Height = 255
Left = 120
Max = 200
Min = -100
TabIndex = 2
Top = 3000
Width = 4455
End
Begin VB.HScrollBar HScroll1
Height = 255
Left = 120
Max = 200
Min = -20
TabIndex = 1
Top = 2640
Width = 4455
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 375
Left = 3240
TabIndex = 0
Top = 3840
Width = 1335
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub HScroll1_Change()
Dim tOli As Double
Dim tTMP As Double
tOli = HScroll1.Value
tTMP = HScroll2.Value
ctlOliCask1.Value = tOli
ctlOliCask1.Temperature = tTMP
End Sub
Private Sub HScroll2_Change()
Dim tOli As Double
Dim tTMP As Double
tOli = HScroll1.Value
tTMP = HScroll2.Value
ctlOliCask1.Value = tOli
ctlOliCask1.Temperature = tTMP
End Sub
KiteGirl 2004-07-12
- 打赏
- 举报
ctlOliCask.ctl文件：（以记事本编辑，令存为ctl文件）
VERSION 5.00
Begin VB.UserControl ctlOliCask
ClientHeight = 3045
ClientLeft = 0
ClientTop = 0
ClientWidth = 870
ScaleHeight = 3045
ScaleWidth = 870
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00808080&
ForeColor = &H80000008&
Height = 2895
Left = 0
ScaleHeight = 2865
ScaleWidth = 705
TabIndex = 0
Top = 0
Width = 735
Begin VB.TextBox txtTL
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H00FFC000&
Height = 270
Left = 0
Locked = -1 'True
TabIndex = 4
Text = "TL"
Top = 480
Width = 255
End
Begin VB.TextBox txtVH
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H0000FFFF&
Height = 270
Left = 0
Locked = -1 'True
TabIndex = 3
Text = "VH"
Top = 0
Width = 255
End
Begin VB.TextBox txtTH
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H000000FF&
Height = 270
Left = 0
Locked = -1 'True
TabIndex = 2
Text = "TH"
Top = 240
Width = 255
End
Begin VB.TextBox txtFL
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H0080FF80&
Height = 270
Left = 0
Locked = -1 'True
TabIndex = 1
Text = "FL"
Top = 720
Width = 255
End
End
End
Attribute VB_Name = "ctlOliCask"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private priOliValue As Double
Private priOliValue_Max As Double
Private priTemperature As Double
Private priTemperature_Min As Double
Private priTemperature_Max As Double
Private priBackColor As Long
'ValueChange事件 当参数发生改变的时候触发此事件。
'Value属性 油位或需要以高度显示的数值
'Max属性 Value属性的上限（下限总为0）。默认为100（单位随意）
'Temperature属性 油温或需要以颜色显示的数值
'TemperatureMin属性 油温上限。默认为100℃
'TemperatureMax属性 油温下限。默认为-40℃
'BackColor属性 背景色
'VH指示标记(黄) Value属性超过上限显示此标记。并触发ValueOver事件
'FL指示标记(绿) Value属性达到上限。并触发ValueFlow事件
'TH指示标记(红) 温度超过上限显示此标记。并触发TemperatureOver事件
'TL指示标记(蓝) 温度低于下限显示此标记。并触发TemperatureLow事件
Public Event ValueChange()
Public Event ValueOver()
Public Event ValueFlow()
Public Event TemperatureOver()
Public Event TemperatureLow()
Private Sub UserControl_Initialize()
priOliValue_Max = 100
priTemperature_Min = -40
priTemperature_Max = 100
priBackColor = &H808080
ValueChange
End Sub
Private Sub UserControl_Resize()
Picture1.Height = UserControl.Height
Picture1.Width = UserControl.Width
End Sub
Public Property Get Value() As Double
Value = priOliValue
End Property
Public Property Let Value(ByVal vNewValue As Double)
priOliValue = vNewValue
ValueChange
End Property
Public Property Get Max() As Double
Max = priOliValue_Max
End Property
Public Property Let Max(ByVal vNewValue As Double)
priOliValue_Max = vNewValue
ValueChange
End Property
Public Property Get Temperature() As Double
Temperature = priTemperature
End Property
Public Property Let Temperature(ByVal vNewValue As Double)
priTemperature = vNewValue
ValueChange
End Property
Public Property Get TemperatureMin() As Double
TemperatureMin = priTemperatureMin
End Property
Public Property Let TemperatureMin(ByVal vNewValue As Double)
priTemperatureMin = vNewValue
ValueChange
End Property
Public Property Get TemperatureMax() As Double
TemperatureMax = priTemperatureMax
End Property
Public Property Let TemperatureMax(ByVal vNewValue As Double)
priTemperatureMax = vNewValue
ValueChange
End Property
Public Property Get BackColor() As Long
BackColor = priBackColor
End Property
Public Property Let BackColor(ByVal vNewValue As Long)
priBackColor = vNewValue
ValueChange
End Property
Private Sub ValueChange()
Dim tOliValue As Double
Dim tTemperature As Double
Dim tValueHigh As Boolean
Dim tTemperatureHigh As Boolean
Dim tTemperatureLow As Boolean
Dim tFlow As Boolean
tOliValue = priOliValue
tTemperature = priTemperature
tValueHigh = tOliValue > priOliValue_Max
tFlow = tOliValue >= priOliValue_Max
tTemperatureHigh = tTemperature > priTemperature_Max
tTemperatureLow = tTemperature < priTemperature_Min
txtVH.Visible = tValueHigh
txtFL.Visible = tFlow
txtTH.Visible = tTemperatureHigh
txtTL.Visible = tTemperatureLow
If tValueHigh Then
tOliValue = priOliValue_Max
RaiseEvent ValueOver
ElseIf tOliValue < 0 Then
tOliValue = 0
End If
If tFlow Then RaiseEvent ValueFlow
If tTemperatureHigh Then
tTemperature = priTemperature_Max
RaiseEvent TemperatureOver
ElseIf tTemperatureLow Then
tTemperature = priTemperature_Min
RaiseEvent TemperatureLow
End If
OliTagDraw Picture1, tOliValue, priOliValue_Max, tTemperature, priTemperature_Max, priTemperature_Min, priBackColor
RaiseEvent ValueChange
End Sub
Private Sub OliTagDraw(ByRef pPictureBox As PictureBox, ByVal pOliTag As Double, ByVal pOliTagMax As Double, ByVal pTMP As Double, Optional ByVal pTMP_Max As Double = 100, Optional ByVal pTMP_Min As Double = -40, Optional ByVal pBackColor As Long = &H808080)
Dim tDesHeight As Double
Dim tTMP_Bound As Double
Dim tTMP_Value As Double
Dim tColorLevel As Long
Dim tColor As Long
tTMP_Bound = Abs(pTMP_Max - pTMP_Min)
tTMP_Value = pTMP - pTMP_Min
If tTMP_Value >= 0 And tTMP_Value <= tTMP_Bound Then
tColorLevel = (255 - ((tTMP_Value * 255) / tTMP_Bound))
tColor = tColorLevel * &H100 + &HFF
Else
tColor = &HFFFFFF
End If
With pPictureBox
tDesHeight = .Height - ((pOliTag * .Height) / pOliTagMax)
pPictureBox.Line (0, tDesHeight)-(.Width, .Height), tColor, BF
pPictureBox.Line (0, 0)-(.Width, tDesHeight), pBackColor, BF
End With
End Sub
VERSION 5.00
Begin VB.UserControl ctlOliCask
ClientHeight = 3045
ClientLeft = 0
ClientTop = 0
ClientWidth = 870
ScaleHeight = 3045
ScaleWidth = 870
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00808080&
ForeColor = &H80000008&
Height = 2895
Left = 0
ScaleHeight = 2865
ScaleWidth = 705
TabIndex = 0
Top = 0
Width = 735
Begin VB.TextBox txtTL
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H00FFC000&
Height = 270
Left = 0
Locked = -1 'True
TabIndex = 4
Text = "TL"
Top = 480
Width = 255
End
Begin VB.TextBox txtVH
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H0000FFFF&
Height = 270
Left = 0
Locked = -1 'True
TabIndex = 3
Text = "VH"
Top = 0
Width = 255
End
Begin VB.TextBox txtTH
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H000000FF&
Height = 270
Left = 0
Locked = -1 'True
TabIndex = 2
Text = "TH"
Top = 240
Width = 255
End
Begin VB.TextBox txtFL
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H0080FF80&
Height = 270
Left = 0
Locked = -1 'True
TabIndex = 1
Text = "FL"
Top = 720
Width = 255
End
End
End
Attribute VB_Name = "ctlOliCask"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private priOliValue As Double
Private priOliValue_Max As Double
Private priTemperature As Double
Private priTemperature_Min As Double
Private priTemperature_Max As Double
Private priBackColor As Long
'ValueChange事件 当参数发生改变的时候触发此事件。
'Value属性 油位或需要以高度显示的数值
'Max属性 Value属性的上限（下限总为0）。默认为100（单位随意）
'Temperature属性 油温或需要以颜色显示的数值
'TemperatureMin属性 油温上限。默认为100℃
'TemperatureMax属性 油温下限。默认为-40℃
'BackColor属性 背景色
'VH指示标记(黄) Value属性超过上限显示此标记。并触发ValueOver事件
'FL指示标记(绿) Value属性达到上限。并触发ValueFlow事件
'TH指示标记(红) 温度超过上限显示此标记。并触发TemperatureOver事件
'TL指示标记(蓝) 温度低于下限显示此标记。并触发TemperatureLow事件
Public Event ValueChange()
Public Event ValueOver()
Public Event ValueFlow()
Public Event TemperatureOver()
Public Event TemperatureLow()
Private Sub UserControl_Initialize()
priOliValue_Max = 100
priTemperature_Min = -40
priTemperature_Max = 100
priBackColor = &H808080
ValueChange
End Sub
Private Sub UserControl_Resize()
Picture1.Height = UserControl.Height
Picture1.Width = UserControl.Width
End Sub
Public Property Get Value() As Double
Value = priOliValue
End Property
Public Property Let Value(ByVal vNewValue As Double)
priOliValue = vNewValue
ValueChange
End Property
Public Property Get Max() As Double
Max = priOliValue_Max
End Property
Public Property Let Max(ByVal vNewValue As Double)
priOliValue_Max = vNewValue
ValueChange
End Property
Public Property Get Temperature() As Double
Temperature = priTemperature
End Property
Public Property Let Temperature(ByVal vNewValue As Double)
priTemperature = vNewValue
ValueChange
End Property
Public Property Get TemperatureMin() As Double
TemperatureMin = priTemperatureMin
End Property
Public Property Let TemperatureMin(ByVal vNewValue As Double)
priTemperatureMin = vNewValue
ValueChange
End Property
Public Property Get TemperatureMax() As Double
TemperatureMax = priTemperatureMax
End Property
Public Property Let TemperatureMax(ByVal vNewValue As Double)
priTemperatureMax = vNewValue
ValueChange
End Property
Public Property Get BackColor() As Long
BackColor = priBackColor
End Property
Public Property Let BackColor(ByVal vNewValue As Long)
priBackColor = vNewValue
ValueChange
End Property
Private Sub ValueChange()
Dim tOliValue As Double
Dim tTemperature As Double
Dim tValueHigh As Boolean
Dim tTemperatureHigh As Boolean
Dim tTemperatureLow As Boolean
Dim tFlow As Boolean
tOliValue = priOliValue
tTemperature = priTemperature
tValueHigh = tOliValue > priOliValue_Max
tFlow = tOliValue >= priOliValue_Max
tTemperatureHigh = tTemperature > priTemperature_Max
tTemperatureLow = tTemperature < priTemperature_Min
txtVH.Visible = tValueHigh
txtFL.Visible = tFlow
txtTH.Visible = tTemperatureHigh
txtTL.Visible = tTemperatureLow
If tValueHigh Then
tOliValue = priOliValue_Max
RaiseEvent ValueOver
ElseIf tOliValue < 0 Then
tOliValue = 0
End If
If tFlow Then RaiseEvent ValueFlow
If tTemperatureHigh Then
tTemperature = priTemperature_Max
RaiseEvent TemperatureOver
ElseIf tTemperatureLow Then
tTemperature = priTemperature_Min
RaiseEvent TemperatureLow
End If
OliTagDraw Picture1, tOliValue, priOliValue_Max, tTemperature, priTemperature_Max, priTemperature_Min, priBackColor
RaiseEvent ValueChange
End Sub
Private Sub OliTagDraw(ByRef pPictureBox As PictureBox, ByVal pOliTag As Double, ByVal pOliTagMax As Double, ByVal pTMP As Double, Optional ByVal pTMP_Max As Double = 100, Optional ByVal pTMP_Min As Double = -40, Optional ByVal pBackColor As Long = &H808080)
Dim tDesHeight As Double
Dim tTMP_Bound As Double
Dim tTMP_Value As Double
Dim tColorLevel As Long
Dim tColor As Long
tTMP_Bound = Abs(pTMP_Max - pTMP_Min)
tTMP_Value = pTMP - pTMP_Min
If tTMP_Value >= 0 And tTMP_Value <= tTMP_Bound Then
tColorLevel = (255 - ((tTMP_Value * 255) / tTMP_Bound))
tColor = tColorLevel * &H100 + &HFF
Else
tColor = &HFFFFFF
End If
With pPictureBox
tDesHeight = .Height - ((pOliTag * .Height) / pOliTagMax)
pPictureBox.Line (0, tDesHeight)-(.Width, .Height), tColor, BF
pPictureBox.Line (0, 0)-(.Width, tDesHeight), pBackColor, BF
End With
End Sub
做一个码农都是奢望 2004-07-10
- 打赏
- 举报
northwolves(狼行天下) .不错啊，自己修改就可以完善了
2004v2004 2004-07-10
- 打赏
- 举报
一楼的差不多了
KiteGirl 2004-07-10
- 打赏
- 举报
测试代码中：
HScroll1 min=0 max=100 控制油位
HScroll2 min=-40 max=100 控制温度
Picture1的尺寸随意，多大都可以。因为我的过程可以根据Picture1的尺寸缩放，因此，油位取值并不限制。
HScroll1 min=0 max=100 控制油位
HScroll2 min=-40 max=100 控制温度
Picture1的尺寸随意，多大都可以。因为我的过程可以根据Picture1的尺寸缩放，因此，油位取值并不限制。
KiteGirl 2004-07-10
- 打赏
- 举报
实际上想画油位这个过程就够了：
pPictureBox是一个PictureBox
pOliTag是油位
pOliTagMax是最高油位
pTMP是温度
pTMP_Min和Max是温度上下限
Public Sub OliTagDraw(ByRef pPictureBox As PictureBox, ByVal pOliTag As Double, ByVal pOliTagMax As Double, ByVal pTMP As Double, Optional ByVal pTMP_Max As Double = 100, Optional ByVal pTMP_Min As Double = -40)
Dim tDesHeight As Double
Dim tTMP_Bound As Double
Dim tTMP_Value As Double
Dim tColorLevel As Long
Dim tColor As Long
tTMP_Bound = pTMP_Max - pTMP_Min
tTMP_Value = pTMP - pTMP_Min
If tTMP_Value >= 0 And tTMP_Value <= tTMP_Bound Then
tColorLevel = (255 - ((tTMP_Value * 255) / tTMP_Bound))
tColor = tColorLevel * &H100 + &HFF
Else
tColor = &HFFFFFF
End If
With pPictureBox
tDesHeight = .Height - ((pOliTag * .Height) / pOliTagMax)
pPictureBox.Line (0, tDesHeight)-(.Width, .Height), tColor, BF
pPictureBox.Line (0, 0)-(.Width, tDesHeight), &H808080, BF
End With
End Sub
测试代码如下：
Private Sub HScroll1_Change()
Dim tOli As Double
Dim tTMP As Double
tOli = HScroll1.Value
tTMP = HScroll2.Value
OliTagDraw Picture1, tOli, 100, tTMP
End Sub
Private Sub HScroll2_Change()
Dim tOli As Double
Dim tTMP As Double
tOli = HScroll1.Value
tTMP = HScroll2.Value
OliTagDraw Picture1, tOli, 100, tTMP
End Sub
下面是没有写完的内容，实在来不及完成了。
Public Type tpOliCask '油桶类型
ctRadius As Double '内径(mm)
ctHeight As Double '内沿高度(mm)(极限液位)
ctNormTag As Double '规范液位(mm)(警戒液位)
ctPatchTag As Double '补充液位(mm)(解决实际应用中液位探测器可能接触不到桶底问题)
olVolume As Double '容量
olSpecificGravity As Double '比重
tmpValue As Double '温度值(℃)
tmpValueMax As Double '值上限(℃)
tmpValueMin As Double '值下限(℃)
tmpValueWatchful As Double '警戒值(℃)
End Type
Const conPI As Double = 3.14159265358979
Public Function OliCask_TagGetByVolume(ByVal pRadius As Double, ByVal pVolume As Double) As Double
Dim tOutTag As Double
tOutTag = tOutVolume / (conPI * (pRadius / 2) ^ 2)
OliCask_TagGetByVolume = tOutTag
End Function
Public Function OliCask_VolumeGetByTag(ByVal pRadius As Double, ByVal pOliTag As Double) As Double
Dim tOutVolume As Double
tOutVolume = (conPI * (pRadius / 2) ^ 2) * pOliTag
OliCask_VolumeGetByTag = tOutVolume
End Function
Public Function OliCask_VolumeGetByWeight(ByVal pWeight As Double, Optional ByVal pSpecificGravity As Double = 1, Optional ByVal pCaskWeight As Double = 0) As Double
Dim tOutVolume As Double
tOutVolume = (pWeight - pCaskWeight) / pSpecificGravity
OliCask_VolumeGetByWeight = tOutVolume
End Function
Public Function OliCask_WeightGetByVolume(ByVal pVolume As Double, Optional ByVal pSpecificGravity As Double = 1, Optional ByVal pCaskWeight As Double = 0) As Double
Dim tOutWeight As Double
tOutWeight = pVolume * pSpecificGravity + pCaskWeight
OliCask_WeightGetByVolume = tOutWeight
End Function
pPictureBox是一个PictureBox
pOliTag是油位
pOliTagMax是最高油位
pTMP是温度
pTMP_Min和Max是温度上下限
Public Sub OliTagDraw(ByRef pPictureBox As PictureBox, ByVal pOliTag As Double, ByVal pOliTagMax As Double, ByVal pTMP As Double, Optional ByVal pTMP_Max As Double = 100, Optional ByVal pTMP_Min As Double = -40)
Dim tDesHeight As Double
Dim tTMP_Bound As Double
Dim tTMP_Value As Double
Dim tColorLevel As Long
Dim tColor As Long
tTMP_Bound = pTMP_Max - pTMP_Min
tTMP_Value = pTMP - pTMP_Min
If tTMP_Value >= 0 And tTMP_Value <= tTMP_Bound Then
tColorLevel = (255 - ((tTMP_Value * 255) / tTMP_Bound))
tColor = tColorLevel * &H100 + &HFF
Else
tColor = &HFFFFFF
End If
With pPictureBox
tDesHeight = .Height - ((pOliTag * .Height) / pOliTagMax)
pPictureBox.Line (0, tDesHeight)-(.Width, .Height), tColor, BF
pPictureBox.Line (0, 0)-(.Width, tDesHeight), &H808080, BF
End With
End Sub
测试代码如下：
Private Sub HScroll1_Change()
Dim tOli As Double
Dim tTMP As Double
tOli = HScroll1.Value
tTMP = HScroll2.Value
OliTagDraw Picture1, tOli, 100, tTMP
End Sub
Private Sub HScroll2_Change()
Dim tOli As Double
Dim tTMP As Double
tOli = HScroll1.Value
tTMP = HScroll2.Value
OliTagDraw Picture1, tOli, 100, tTMP
End Sub
下面是没有写完的内容，实在来不及完成了。
Public Type tpOliCask '油桶类型
ctRadius As Double '内径(mm)
ctHeight As Double '内沿高度(mm)(极限液位)
ctNormTag As Double '规范液位(mm)(警戒液位)
ctPatchTag As Double '补充液位(mm)(解决实际应用中液位探测器可能接触不到桶底问题)
olVolume As Double '容量
olSpecificGravity As Double '比重
tmpValue As Double '温度值(℃)
tmpValueMax As Double '值上限(℃)
tmpValueMin As Double '值下限(℃)
tmpValueWatchful As Double '警戒值(℃)
End Type
Const conPI As Double = 3.14159265358979
Public Function OliCask_TagGetByVolume(ByVal pRadius As Double, ByVal pVolume As Double) As Double
Dim tOutTag As Double
tOutTag = tOutVolume / (conPI * (pRadius / 2) ^ 2)
OliCask_TagGetByVolume = tOutTag
End Function
Public Function OliCask_VolumeGetByTag(ByVal pRadius As Double, ByVal pOliTag As Double) As Double
Dim tOutVolume As Double
tOutVolume = (conPI * (pRadius / 2) ^ 2) * pOliTag
OliCask_VolumeGetByTag = tOutVolume
End Function
Public Function OliCask_VolumeGetByWeight(ByVal pWeight As Double, Optional ByVal pSpecificGravity As Double = 1, Optional ByVal pCaskWeight As Double = 0) As Double
Dim tOutVolume As Double
tOutVolume = (pWeight - pCaskWeight) / pSpecificGravity
OliCask_VolumeGetByWeight = tOutVolume
End Function
Public Function OliCask_WeightGetByVolume(ByVal pVolume As Double, Optional ByVal pSpecificGravity As Double = 1, Optional ByVal pCaskWeight As Double = 0) As Double
Dim tOutWeight As Double
tOutWeight = pVolume * pSpecificGravity + pCaskWeight
OliCask_WeightGetByVolume = tOutWeight
End Function
KiteGirl 2004-07-10
- 打赏
- 举报
我事情我帮你搞定，你等一下！
hhjjhjhj 2004-07-09
- 打赏
- 举报
简单地说就是用二个控件，一个作为桶，一作为油，控制“油”控件的高度即可
bzdl 2004-07-09
- 打赏
- 举报
bd
northwolves 2004-07-09
- 打赏
- 举报
'add picturebox1,picturebox2,vscroll1 to form1,then slide vscroll1:
Option Explicit
Private Sub Form_Load()
Me.Move Screen.Width / 2 - 2000, Screen.Height / 2 - 3000, 4000, 6000
Picture1.Move 200, 200, 3200, 5000
VScroll1.Move 3500, 200, 400, 5000
VScroll1.Min = 100
VScroll1.Max = 0
VScroll1.Value = 5
Picture1.Scale (0, 100)-(100, 0)
Set Picture2.Container = Picture1
Picture2.BackColor = vbYellow
Picture2.BorderStyle = 0
Picture2.Move 0, 5, 100, 5
Picture2.Cls
Picture2.CurrentX = Picture2.Width / 2
Picture2.CurrentY = 0
Picture2.Print " There are 5 L oil in the 100 L tank "
End Sub
Private Sub VScroll1_Change()
Dim h As Integer
h = VScroll1.Value
Picture2.Move 0, h, 100, h
Picture2.Cls
Picture2.CurrentX = 0
Picture2.CurrentY = 0
Picture2.Print " There are " & h & "L oil in the 100L tank "
End Sub
Option Explicit
Private Sub Form_Load()
Me.Move Screen.Width / 2 - 2000, Screen.Height / 2 - 3000, 4000, 6000
Picture1.Move 200, 200, 3200, 5000
VScroll1.Move 3500, 200, 400, 5000
VScroll1.Min = 100
VScroll1.Max = 0
VScroll1.Value = 5
Picture1.Scale (0, 100)-(100, 0)
Set Picture2.Container = Picture1
Picture2.BackColor = vbYellow
Picture2.BorderStyle = 0
Picture2.Move 0, 5, 100, 5
Picture2.Cls
Picture2.CurrentX = Picture2.Width / 2
Picture2.CurrentY = 0
Picture2.Print " There are 5 L oil in the 100 L tank "
End Sub
Private Sub VScroll1_Change()
Dim h As Integer
h = VScroll1.Value
Picture2.Move 0, h, 100, h
Picture2.Cls
Picture2.CurrentX = 0
Picture2.CurrentY = 0
Picture2.Print " There are " & h & "L oil in the 100L tank "
End Sub
