frmparameter.frm

完整的VB和单片机系统连接的源代码

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmPara 
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "参数查看和修改"
   ClientHeight    =   7185
   ClientLeft      =   45
   ClientTop       =   315
   ClientWidth     =   8520
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7185
   ScaleWidth      =   8520
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton cmdHelp 
      Caption         =   "帮助"
      Height          =   375
      Left            =   7440
      TabIndex        =   9
      Top             =   6720
      Width           =   735
   End
   Begin VB.CommandButton cmdApply 
      Caption         =   "应用"
      Height          =   375
      Left            =   3360
      TabIndex        =   8
      Top             =   6720
      Width           =   855
   End
   Begin VB.CheckBox chkSim 
      Caption         =   "模拟写入参数"
      Height          =   255
      Left            =   240
      TabIndex        =   7
      Top             =   6720
      Width           =   1455
   End
   Begin VB.CheckBox chkRefresh 
      Caption         =   "刷新"
      Height          =   375
      Left            =   2040
      Style           =   1  'Graphical
      TabIndex        =   6
      Top             =   6720
      Width           =   855
   End
   Begin VB.CommandButton cmdClose 
      Cancel          =   -1  'True
      Caption         =   "关闭"
      Height          =   375
      Left            =   4680
      TabIndex        =   5
      Top             =   6720
      Width           =   855
   End
   Begin MSComctlLib.ProgressBar barP 
      Height          =   135
      Left            =   240
      TabIndex        =   4
      Top             =   6480
      Width           =   5895
      _ExtentX        =   10398
      _ExtentY        =   238
      _Version        =   393216
      Appearance      =   0
   End
   Begin MSComctlLib.ListView LstVwPara 
      Height          =   6015
      Left            =   240
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   360
      Width           =   5895
      _ExtentX        =   10398
      _ExtentY        =   10610
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      FullRowSelect   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   12632256
      Appearance      =   1
      NumItems        =   0
   End
   Begin VB.Label Label2 
      BackColor       =   &H00C0C0C0&
      Caption         =   "参数说明"
      Height          =   255
      Left            =   6840
      TabIndex        =   3
      Top             =   120
      Width           =   855
   End
   Begin VB.Label Label1 
      BackColor       =   &H00C0C0C0&
      Caption         =   "参数列表"
      Height          =   255
      Left            =   2760
      TabIndex        =   2
      Top             =   120
      Width           =   855
   End
   Begin VB.Label lblParaHelp 
      BackColor       =   &H00C0C0C0&
      Caption         =   "单击参数来查看说明"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000001&
      Height          =   5895
      Left            =   6360
      TabIndex        =   1
      Top             =   480
      Width           =   1935
   End
End
Attribute VB_Name = "frmPara"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'/Dim ParaRefreshFlag As Boolean


Const ParaNumber = 200

Const ParaNumber0 = 0
Const ParaNumber1 = 37
Const ParaNumber2 = 42
Const BitNumber0 = 100
Const BitNumber1 = 100 + 42
Const BitNumber2 = 100 + 44

'从0号开始
Const IDX_GAP_DEPTH = 3 '脉冲距离
Const IDX_SPEED_DEVIDE = 4 '速度分频
Const IDX_SHOW_STYLE = 24 '深度显示方式
Const IDX_MAX_PNUM = 25 '深度最大值
Const IDX_WELL_DEPTH = 2 '井深脉冲数
Const IDX_DOUBLE_SIDE_WORK_TIMES = 68 '单罐还是双罐：0：单罐




Dim sParameterHelp As String





Public Sub RefreshPara(id As Integer) '刷新一个参数
    ComSendAnalize SendIs_ReadPara, id, 0
End Sub

Public Sub ReceivePara(id As Integer, Val As Integer, isRead As Boolean)  '接收到一个参数 refresh_next=true:read
    Dim i As Integer
    For i = 0 To LstVwPara.ListItems.Count - 1
        If LstVwPara.ListItems(i + 1).Text = Trim(Str(id)) Then
            If Me.Visible = True Then LstVwPara.SetFocus
            LstVwPara.ListItems(i + 1).Selected = True
            If isRead = False Then '修改数据成功
                Call SaveLog("将参数(" & LstVwPara.ListItems(i + 1).Text & ")的值从" & _
                        LstVwPara.ListItems(i + 1).SubItems(1) & "改为" & Trim(Str(Val)))
            End If
            LstVwPara.ListItems(i + 1).SubItems(1) = Trim(Str(Val))
        End If
    Next
    
    If isRead = True Then '读到数据
        If chkRefresh.Value = 1 Then
            If id < BitNumber1 Then '继续刷新
                If id = ParaNumber1 Then id = BitNumber0 - 1
                RefreshPara id + 1
                barP.Value = id * 100 / BitNumber1
            Else
                Call SaveLog("刷新所有参数成功")
                chkRefresh.Value = 0
            End If
        End If
    End If
End Sub

Private Sub chkRefresh_Click() '按下刷新键

    If chkRefresh.Value = 1 Then
        If com.port = True Then
            RefreshPara 0
            Call SaveLog("刷新所有参数...")
        Else
            MsgBox "串口没有打开,不能发送数据！"
            chkRefresh.Value = 0
        End If
    Else
        barP.Value = 0
    End If
End Sub


Private Sub cmdApply_Click()
        Call SynchrolizeShow
End Sub

Public Sub SynchrolizeShow()                                '   同步显示设置
    Dim f As Single
    On Error GoTo aErr
    With MainSetting
            f = LstVwPara.ListItems(IDX_GAP_DEPTH + 1).SubItems(1) '脉冲距离
        .GapDepth = f / 100000
            f = LstVwPara.ListItems(IDX_SPEED_DEVIDE + 1).SubItems(1) '速度分频
        .SpeedDevide = f
            f = LstVwPara.ListItems(IDX_SHOW_STYLE + 1).SubItems(1) '深度显示方式
        .depth_style = f Mod 4
        '    f = LstVwPara.ListItems(IDX_MAX_PNUM + 1).SubItems(1) '深度最大值
        '.max_pnum = f
            f = LstVwPara.ListItems(IDX_WELL_DEPTH + 1).SubItems(1) '井深脉冲数
        .well_depth = f
        frmMain.HSpicXscale.Value = f * .GapDepth
    End With
    Exit Sub
aErr:
    MainSetting.GapDepth = 0.1
End Sub

Public Function GetIfDoubleSideWork()
    On Error GoTo aErr
    GetIfDoubleSideWork = LstVwPara.ListItems(IDX_DOUBLE_SIDE_WORK_TIMES).SubItems(1)
    Exit Function
aErr:
    GetIfDoubleSideWork = 1
End Function







Private Sub cmdClose_Click() '关闭窗口
    Me.Hide
End Sub


Private Sub cmdHelp_Click()
    lblParaHelp.Caption = " --- 帮助 ---" & vbCrLf & vbCrLf & _
        "单击参数来查看说明，若需要，请刷新参数。" & vbCrLf & vbCrLf & _
        "【刷新】从下位机中刷新所有参数。" & vbCrLf & vbCrLf & _
        "【应用】将参数应用到界面显示。这将会更新软件界面的" & vbCrLf & _
        "  (1)井深范围" & vbCrLf & _
        "  (2)脉冲距离" & vbCrLf & _
        "  (3)速度分频" & vbCrLf & _
        "  (4)深度显示方式" & vbCrLf & vbCrLf & _
        "【模拟写入】选中后，将模拟写入参数(实际上并未写到下位机中)。"
End Sub

Private Sub Form_Load()
    Dim itmx
    Dim i
    Dim fs As String, s As String
    
    Open fnParameterHelp For Binary As 1
       sParameterHelp = Space(LOF(1))
    Get 1, , sParameterHelp
    Close 1
    
    fs = fnParameter
    
    LstVwPara.ColumnHeaders.add 1, , "序号", LstVwPara.Width * 1 / 10
    LstVwPara.ColumnHeaders.add 2, , "值", LstVwPara.Width * 2 / 10
    LstVwPara.ColumnHeaders.add 3, , "说明", LstVwPara.Width * 7 / 10
    
    LstVwPara.View = lvwReport

    
    
    For i = ParaNumber0 To ParaNumber1          '参数
        GoSub AddSubItems
    Next i
    For i = BitNumber0 To BitNumber1            '位参数
        GoSub AddSubItems
    Next i
    
    Call cmdHelp_Click

    Exit Sub
AddSubItems:
       Set itmx = LstVwPara.ListItems.add()
       itmx.Text = i '序号
       itmx.SubItems(1) = ReadIniFile(fs, Right("00" & Trim(Str(i)), 3), "Value", s, "0")
       itmx.SubItems(2) = ReadIniFile(fs, Right("00" & Trim(Str(i)), 3), "Name", s, "0")
Return
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim i As Integer, fs As String
    fs = fnParameter
    For i = 0 To LstVwPara.ListItems.Count - 1
        Call WriteIniFile(fs, Right("00" & Trim(Str(LstVwPara.ListItems(i + 1).Text)), 3), "Value", LstVwPara.ListItems(i + 1).SubItems(1))
    Next
End Sub



Private Function GetParaHelp(id As Integer) As String
    Dim s As String
    Dim ss
    On Error GoTo aErr
    ss = Split(sParameterHelp, "[" & Right("00" & Trim(Str(id)), 3) & "]")
    s = ss(1)
    ss = Split(s, "[END]")
    s = ss(0)
    s = Right(s, Len(s) - 2)
    GetParaHelp = s
    Exit Function
aErr:
    GetParaHelp = "?"
End Function


Private Sub LstVwPara_Click()
    Dim i As Integer
    On Error GoTo aErr
    i = LstVwPara.SelectedItem.Text
    lblParaHelp.Caption = GetParaHelp(i)
    Exit Sub
aErr:
End Sub

Private Sub LstVwPara_DblClick()
    Dim i As Integer, j As Integer, k As Integer, n
    On Error GoTo aErr
    i = LstVwPara.SelectedItem.Text
    j = LstVwPara.SelectedItem.SubItems(1)
    n = InputBox("输入第" + Trim(Str(i)) + "参数值", "输入参数值", j)
    If n = "" Then Exit Sub
    k = n
    'If k = j Then Exit Sub
    If chkSim.Value = 0 Then
        If com.port = True Then
            'MsgBox "参数" + Trim(Str(i)) + "原值为" + Trim(Str(j)) + "改为" + Trim(Str(k)) + "的命令已经送出。"
            ComSendAnalize SendIs_WritePara, i, k
        Else
            MsgBox "串口没有打开,不能发送数据！"
        End If
    Else
        ReceivePara i, k, False
    End If
    Exit Sub
aErr:
    MsgBox "错误的输入！"
End Sub

Private Sub LstVwPara_KeyUp(KeyCode As Integer, Shift As Integer)
        LstVwPara_Click
End Sub

Private Sub LstVwPara_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        LstVwPara_DblClick
    End If
End Sub