frmmain.frm

模拟屏驱动

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form FrmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "PWT模拟屏驱动"
   ClientHeight    =   3810
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   2520
   Icon            =   "FrmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3810
   ScaleWidth      =   2520
   StartUpPosition =   3  '窗口缺省
   WindowState     =   1  'Minimized
   Begin VB.TextBox TxtSetting 
      Enabled         =   0   'False
      Height          =   375
      Left            =   1200
      TabIndex        =   11
      Text            =   "0"
      Top             =   2040
      Width           =   1215
   End
   Begin VB.TextBox TxtComm 
      Enabled         =   0   'False
      Height          =   375
      Left            =   1200
      TabIndex        =   9
      Text            =   "0"
      Top             =   1560
      Width           =   1215
   End
   Begin VB.CommandButton CmdDateTime 
      Caption         =   "对时"
      Height          =   495
      Left            =   240
      TabIndex        =   5
      Top             =   2640
      Width           =   1575
   End
   Begin VB.TextBox TxtOutput 
      Enabled         =   0   'False
      Height          =   375
      Left            =   1200
      TabIndex        =   4
      Text            =   "0"
      Top             =   120
      Width           =   1215
   End
   Begin VB.TextBox TxtTimes 
      Enabled         =   0   'False
      Height          =   375
      Left            =   1200
      TabIndex        =   2
      Text            =   "200"
      Top             =   600
      Width           =   1215
   End
   Begin VB.Timer TimerSend 
      Enabled         =   0   'False
      Interval        =   200
      Left            =   600
      Top             =   4440
   End
   Begin VB.CommandButton CmdExit 
      Caption         =   "关闭"
      Height          =   495
      Left            =   240
      TabIndex        =   1
      Top             =   3240
      Width           =   1575
   End
   Begin MSCommLib.MSComm MSCommMNP 
      Left            =   2520
      Top             =   720
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
      BaudRate        =   19200
   End
   Begin VB.TextBox TxtDDE 
      Enabled         =   0   'False
      Height          =   375
      Index           =   0
      Left            =   1200
      TabIndex        =   0
      Text            =   "0"
      Top             =   1080
      Width           =   1215
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "串口设置："
      Height          =   180
      Index           =   4
      Left            =   360
      TabIndex        =   10
      Top             =   2160
      Width           =   900
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "通 信 口："
      Height          =   180
      Index           =   3
      Left            =   360
      TabIndex        =   8
      Top             =   1680
      Width           =   900
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "发码周期："
      Height          =   180
      Index           =   2
      Left            =   360
      TabIndex        =   7
      Top             =   720
      Width           =   900
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "发送原码："
      Height          =   180
      Index           =   1
      Left            =   360
      TabIndex        =   6
      Top             =   240
      Width           =   900
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "DDE 数值："
      Height          =   180
      Index           =   0
      Left            =   360
      TabIndex        =   3
      Top             =   1200
      Width           =   900
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim k As Integer
Dim i As Integer
Dim s As String
Dim P(1000) As Points

Private Sub CmdDateTime_Click()
    s = "[HD" & Mid(CStr(Now), 3, 2) & Mid(CStr(Now), 6, 2) & Mid(CStr(Now), 9, 2) & Mid(CStr(Now), 12, 2) & Mid(CStr(Now), 15, 2) & Mid(CStr(Now), 18, 2) & "]"
    TxtOutput = s
    MSCommMNP.Output = s
End Sub

Private Sub CmdExit_Click()
    End
End Sub




Private Sub Form_Load()
    Dim Cn As New Connection
    Dim rs As New ADODB.Recordset
    Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DB.mdb;Persist Security Info=False"
    rs.ActiveConnection = Cn
    rs.CursorLocation = adUseClient
    rs.Open "select * from Def", Cn, adOpenStatic, adLockOptimistic
    Do While Not rs.EOF
        i = i + 1
        Load TxtDDE(i)
        TxtDDE(i).LinkTopic = rs("EXE") & "|" & rs("Topic")
        TxtDDE(i).LinkItem = rs("item")
        TxtDDE(i).LinkMode = 2
        P(i).Address = rs("Address")
        P(i).Type = rs("Type")
        rs.MoveNext
    Loop
    k = i
    i = 0
    rs.Close
    rs.Open "select * from Comm", Cn, adOpenStatic, adLockOptimistic
    If Not rs.EOF Then
        MSCommMNP.CommPort = rs("通讯口")
        MSCommMNP.Settings = rs("通讯参数")
        TimerSend.Interval = rs("发码周期")
        TxtTimes = rs("发码周期")
        TxtComm = "com" & rs("通讯口")
        TxtSetting = rs("通讯参数")
    End If
    Cn.Close
    MSCommMNP.PortOpen = True
    TimerSend.Enabled = True
End Sub


Private Sub TimerSend_Timer()
   On Error Resume Next
    If i < k Then
        i = i + 1
    Else
        i = 1
    End If
    TxtDDE(i).LinkRequest
    If TxtDDE(i) >= 1000 Then
        TxtDDE(i) = Int(TxtDDE(i))
    Else
        If TxtDDE(i) >= 100 Then
            TxtDDE(i) = FormatNumber(TxtDDE(i), 1)
        Else
            If TxtDDE(i) >= 10 Then
                TxtDDE(i) = FormatNumber(TxtDDE(i), 2)
            Else
                TxtDDE(i) = FormatNumber(TxtDDE(i), 3)
            End If
        End If
    End If
    TxtDDE(0) = TxtDDE(i)
    
    Select Case P(i).Type
        Case 1
            s = "[P" & P(i).Address & "D" & TxtDDE(i).Text & "]"
        Case 2
            s = "[I" & ((P(i).Address - 1000) \ 100) & "D" & ((P(i).Address - 1000) Mod 100) & IIf(TxtDDE(i).Text = 0, "M", "G") & "]"
        Case 4
            s = "[G" & ((P(i).Address - 1000) \ 100) & "D" & ((P(i).Address - 1000) Mod 100) & IIf(TxtDDE(i).Text = 0, "M", "R") & "]"
    End Select
    TxtOutput = s
    MSCommMNP.Output = s
End Sub

Private Sub TxtTimes_Change()
    On Error Resume Next
    TimerSend.Interval = TxtTimes
End Sub