📄 example measurement.frm
字号:
VERSION 5.00
Begin VB.Form Form1
Caption = "Example: Measurement"
ClientHeight = 6435
ClientLeft = 60
ClientTop = 345
ClientWidth = 6975
LinkTopic = "Form1"
ScaleHeight = 6435
ScaleWidth = 6975
StartUpPosition = 3 'Windows Default
Begin VB.Frame Frame2
Caption = "Measurement"
Height = 2415
Left = 240
TabIndex = 14
Top = 3720
Width = 6495
Begin VB.TextBox MDFFilename
Height = 285
Left = 4680
TabIndex = 21
Text = "*.MDF"
Top = 1920
Width = 1575
End
Begin VB.CommandButton MStop
Caption = "Stop Measurement"
Height = 375
Left = 4680
TabIndex = 20
Top = 840
Width = 1575
End
Begin VB.CommandButton MStart
Caption = "Start Measurement"
Height = 375
Left = 4680
TabIndex = 19
Top = 360
Width = 1575
End
Begin VB.CommandButton Clear
Caption = "Clear Channels"
Height = 375
Left = 1680
TabIndex = 18
Top = 840
Width = 1335
End
Begin VB.ListBox Channels
Height = 1815
Left = 3240
TabIndex = 17
Top = 360
Width = 1215
End
Begin VB.CommandButton SelectChannels
Caption = "Select Channels"
Height = 375
Left = 1680
TabIndex = 16
Top = 360
Width = 1335
End
Begin VB.ListBox TaskIDs
Height = 1815
Left = 240
TabIndex = 15
Top = 360
Width = 1215
End
Begin VB.Label Label6
Caption = "MDF Datei"
Height = 255
Left = 4680
TabIndex = 22
Top = 1680
Width = 1575
End
End
Begin VB.CommandButton Stop
Caption = "Stop CANape"
Height = 375
Left = 480
TabIndex = 3
Top = 2160
Width = 1215
End
Begin VB.Frame Frame1
Caption = "Start/Stop"
Height = 2415
Left = 240
TabIndex = 1
Top = 1080
Width = 6495
Begin VB.TextBox Channel
Height = 285
Left = 5400
TabIndex = 13
Text = "1"
Top = 1800
Width = 615
End
Begin VB.TextBox Driver
Height = 285
Left = 3480
TabIndex = 12
Text = "CCP"
Top = 1800
Width = 1095
End
Begin VB.TextBox Devicename
Height = 285
Left = 3480
TabIndex = 11
Text = "CCPsim"
Top = 1440
Width = 2535
End
Begin VB.TextBox Database
Height = 285
Left = 3480
TabIndex = 10
Text = "ccpsim.a2l"
Top = 1080
Width = 2535
End
Begin VB.TextBox WorkDir
Height = 285
Left = 2040
TabIndex = 4
Text = "d:\Programme\canape\ccpsim"
Top = 600
Width = 3975
End
Begin VB.CommandButton Start
Caption = "Start CANape"
Height = 375
Left = 240
TabIndex = 2
Top = 480
Width = 1215
End
Begin VB.Label Label5
Caption = "Channel"
Height = 255
Left = 4680
TabIndex = 9
Top = 1800
Width = 855
End
Begin VB.Label Label4
Caption = "Driver"
Height = 255
Left = 2040
TabIndex = 8
Top = 1800
Width = 1455
End
Begin VB.Label Label3
Caption = "Devicename"
Height = 255
Left = 2040
TabIndex = 7
Top = 1440
Width = 1575
End
Begin VB.Label Label2
Caption = "ASAP2 File (*.a2l)"
Height = 255
Left = 2040
TabIndex = 6
Top = 1080
Width = 1455
End
Begin VB.Label Label1
Caption = "Working Directory"
Height = 255
Left = 2040
TabIndex = 5
Top = 360
Width = 3975
End
End
Begin VB.Line Line1
BorderColor = &H000000FF&
X1 = 0
X2 = 6960
Y1 = 600
Y2 = 600
End
Begin VB.Label Headline
Caption = "Example: Measurement"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 0
Top = 240
Width = 3255
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim CANapeApplication As Application
Dim CANapeDevice As Device
Dim CANapePath As String
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
' Note that if you declare the lpData parameter as String, you must pass it By Value.
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const ERROR_SUCCESS = 0&
Private Const KEY_READ = &H20019
Private Sub Clear_Click()
On Error GoTo Fail
Dim task
Set task = CANapeDevice.Tasks(TaskIDs.ListIndex + 1)
task.Channels.Clear
Channels.Clear
Exit Sub
Fail:
ShowError
End Sub
Private Sub Form_Load()
On Error GoTo Fail
Set CANapeApplication = New CANAPELib.Application
MStop.Enabled = False
Dim phk As Long
Dim pData As String * 255
s = Len(pData) - 1
t = 0
CANapePath = "c:\Programme\CANape"
res = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\VECTOR\CANape", 0, KEY_READ, phk)
If res = ERROR_SUCCESS Then
res = RegQueryValueEx(phk, "Path", 0, t, pData, s)
If res = ERROR_SUCCESS Then
CANapePath = Left(pData, s - 1)
If Right(CANapePath, 1) = "@" Then
CANapePath = Left(CANapePath, s - 2)
End If
Else
End If
End If
WorkDir.Text = CANapePath & "\CCPsim"
Exit Sub
Fail:
ShowError
End Sub
Private Sub MStart_Click()
On Error GoTo Fail
CANapeApplication.Measurement.MDFFilename = MDFFilename.Text
' Set Save2MDF Flag for all Channels
For Each t In CANapeDevice.Tasks
For Each c In t.Channels
c.Save2MDF = 1
Next c
Next t
CANapeApplication.Measurement.Start
MStart.Enabled = False
MStop.Enabled = True
' call NextSample for each task
Dim timeStamp As Long
While CANapeApplication.Measurement.Running
For Each t In CANapeDevice.Tasks
v = t.NextSample(timeStamp)
DoEvents
Next t
Wend
MStart.Enabled = True
MStop.Enabled = False
MsgBox "The Measurements have been stored in file " & MDFFilename.Text
Exit Sub
Fail:
ShowError
End Sub
Private Sub MStop_Click()
On Error GoTo Fail
CANapeApplication.Measurement.Stop
Exit Sub
Fail:
ShowError
End Sub
Private Sub SelectChannels_Click()
On Error GoTo Fail
Dim task
Set task = CANapeDevice.Tasks(TaskIDs.ListIndex + 1)
task.Channels.Add
Channels.Clear
For Each c In task.Channels
Channels.AddItem c.Name
Next c
Exit Sub
Fail:
ShowError
End Sub
Private Sub Start_Click()
On Error GoTo Fail
Call CANapeApplication.Open(WorkDir.Text, 0)
Set CANapeDevice = CANapeApplication.Devices.Add(Devicename.Text, Database.Text, Driver.Text, Val(Channel.Text))
Channels.Clear
For Each t In CANapeDevice.Tasks
TaskIDs.AddItem t.Name
Next t
MDFFilename.Text = CANapeApplication.Measurement.MDFFilename
Exit Sub
Fail:
ShowError
End Sub
Private Sub Stop_Click()
On Error GoTo Fail
Call CANapeApplication.Quit
TaskIDs.Clear
Channels.Clear
Exit Sub
Fail:
ShowError
End Sub
Sub ShowError()
ErrMsg = "The object returned the following error: " & Chr(13) & Chr(13) & _
"Code: 0x" & Hex(Err.Number) & Chr(13) & _
"Source: " & Err.Source & Chr(13) & _
"Description: " & Err.Description
MsgBox ErrMsg, vbSystemModal + vbMsgBoxHelpButton, "Error", Err.HelpFile, Err.HelpContext
End Sub
Private Sub TaskIDs_Click()
On Error GoTo Fail
Channels.Clear
Dim task
Set task = CANapeDevice.Tasks(TaskIDs.ListIndex + 1)
For Each c In task.Channels
Channels.AddItem c.Name
Next c
Exit Sub
Fail:
ShowError
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -