📄 example calibration.frm
字号:
VERSION 5.00
Begin VB.Form Form1
Caption = "Example: Calibration"
ClientHeight = 8280
ClientLeft = 60
ClientTop = 345
ClientWidth = 11745
LinkTopic = "Form1"
ScaleHeight = 8280
ScaleWidth = 11745
StartUpPosition = 3 'Windows Default
Begin VB.Frame Frame3
Caption = "Memory"
Height = 2415
Left = 6720
TabIndex = 22
Top = 1080
Width = 4815
Begin VB.TextBox Size
Height = 285
Left = 2760
TabIndex = 26
Text = "8"
Top = 1320
Width = 1095
End
Begin VB.TextBox Adress
Height = 285
Left = 2760
TabIndex = 25
Text = "270000"
Top = 480
Width = 1095
End
Begin VB.CommandButton WriteMemory
Caption = "Write"
Height = 375
Left = 240
TabIndex = 24
Top = 1800
Width = 1215
End
Begin VB.CommandButton ReadMemory
Caption = "Read"
Height = 375
Left = 240
TabIndex = 23
Top = 1200
Width = 1215
End
Begin VB.Label Label11
Caption = "dec"
Height = 255
Left = 3960
TabIndex = 31
Top = 480
Width = 615
End
Begin VB.Label Label9
Caption = "Array(0,1,2,3,4,5,6,7,8,9)"
Height = 255
Left = 1800
TabIndex = 30
Top = 1800
Width = 2535
End
Begin VB.Label Label10
Caption = "Bytes"
Height = 255
Left = 3960
TabIndex = 29
Top = 1320
Width = 615
End
Begin VB.Label Label8
Caption = "Size"
Height = 255
Left = 1800
TabIndex = 28
Top = 1320
Width = 615
End
Begin VB.Label Label7
Caption = "Adress"
Height = 255
Left = 1800
TabIndex = 27
Top = 480
Width = 735
End
End
Begin VB.Frame Frame2
Caption = "Objects"
Height = 4335
Left = 240
TabIndex = 14
Top = 3720
Width = 11295
Begin VB.ListBox Value
Height = 2790
Left = 2400
TabIndex = 20
Top = 1200
Width = 8655
End
Begin VB.OptionButton Option1
Caption = "Measurement"
Height = 255
Index = 1
Left = 240
TabIndex = 19
Top = 720
Width = 1335
End
Begin VB.OptionButton Option1
Caption = "Calibration"
Height = 255
Index = 0
Left = 240
TabIndex = 18
Top = 360
Value = -1 'True
Width = 1215
End
Begin VB.CommandButton Clear
Caption = "Clear"
Height = 375
Left = 3000
TabIndex = 17
Top = 360
Width = 1215
End
Begin VB.CommandButton Select
Caption = "Select"
Height = 375
Left = 1680
TabIndex = 16
Top = 360
Width = 1215
End
Begin VB.ListBox Objects
Height = 2790
Left = 240
TabIndex = 15
Top = 1200
Width = 2055
End
Begin VB.Label Label6
Caption = "Value"
Height = 255
Left = 2400
TabIndex = 21
Top = 960
Width = 975
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 = 6255
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 = 11760
Y1 = 600
Y2 = 600
End
Begin VB.Label Headline
Caption = "Example: Calibration"
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()
CANapeDevice.CalibrationObjects.Clear
Objects.Clear
Value.Clear
Exit Sub
Fail:
ShowError
End Sub
Private Sub Form_Load()
On Error GoTo Fail
Set CANapeApplication = New CANAPELib.Application
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 Objects_Click()
On Error GoTo Fail
Set o = CANapeDevice.CalibrationObjects(Objects.Text)
Call PrintValue(o)
Exit Sub
Fail:
ShowError
End Sub
Private Sub ReadMemory_Click()
On Error GoTo Fail
v = CANapeDevice.ReadMemory(Val(Adress.Text), Val(Size.Text))
s = "Values (dec): | "
For Each b In v
s = s & b & " | "
Next b
MsgBox s
Exit Sub
Fail:
ShowError
End Sub
Private Sub Select_Click()
On Error GoTo Fail
If Option1(0) Then
CANapeDevice.CalibrationObjects.Add ("OTT_CALIBRATE")
Else
CANapeDevice.CalibrationObjects.Add ("OTT_MEASURE")
End If
Objects.Clear
For Each o In CANapeDevice.CalibrationObjects
Objects.AddItem o.Name
Next o
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))
Exit Sub
Fail:
ShowError
End Sub
Private Sub Stop_Click()
On Error GoTo Fail
Call CANapeApplication.Quit
Objects.Clear
Value.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 PrintValue(o)
On Error GoTo Fail
Value.Clear
If o.XDim > 1 Or o.YDim > 1 Then
If o.YDim = 1 Then
'Kennlinie
s = ""
For Each b In o.Value
s = s & b & " | "
Next b
Value.AddItem s
Else
'Kennfeld
v = o.Value
For a = 0 To o.YDim - 1
s = ""
For b = 0 To o.XDim - 1
s = s & v(a, b) & " | "
Next b
Value.AddItem s
Next a
End If
Else
Value.AddItem o.Value
End If
Exit Sub
Fail:
ShowError
End Sub
Private Sub WriteMemory_Click()
On Error GoTo Fail
Data = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
Call CANapeDevice.WriteMemory(Val(Adress.Text), Data)
Exit Sub
Fail:
ShowError
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -