frmmain.frm

来自「vb的关于上下位机通讯程序」· FRM 代码 · 共 589 行 · 第 1/2 页

            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   210
         Index           =   1
         Left            =   360
         TabIndex        =   1
         Top             =   720
         Width           =   1050
      End
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "54"
      ForeColor       =   &H00FF0000&
      Height          =   180
      Left            =   4313
      TabIndex        =   22
      Top             =   7560
      Width           =   195
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "周期(ms)"
      BeginProperty Font 
         Name            =   "华文新魏"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   210
      Left            =   1680
      TabIndex        =   17
      Top             =   6840
      Width           =   825
   End
End
Attribute VB_Name = "frmmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private datano As Long
Private datatvalue As Single
Private datatype As Integer
Private cycle As Integer
Private xmax As Single
Private ymax As Single
Private xaxismax As Integer
Private yaxismax As Integer
Private a As Single
Private setting As String
Private no As Integer
Private flag As Integer
Private Const pi = 3.1415926
Private Const max = 1000
Private conn As adodb.Connection
Dim dbrst As adodb.Recordset
Private Sub AddData()
Dim sqltext As String
sqltext = "select * from db1 where datano is null  "
dbrst.Open sqltext, , 2, 3
dbrst.AddNew
dbrst("datano") = datano
dbrst("datavalue") = a
dbrst.Update
dbrst.Close
End Sub
Private Sub refreshgrid()
Dim i As Integer
Grid1.TextMatrix(no, 0) = datano
Grid1.TextMatrix(no, 1) = a
If datano Mod 20 = 0 Then
    Grid1.TopRow = no
End If
If datano Mod 1000 = 1 Then
    Grid1.Clear
    no = 0
    Grid1.Clear
    Grid1.TopRow = 1
    'grid initial
    Grid1.TextMatrix(0, 0) = "采样号"
    Grid1.TextMatrix(0, 1) = "采样值"
End If

End Sub
Private Sub draw()
If datano Mod 100 <> 0 Then
Picture1.Line -((datano Mod 100) * xmax / 100, a * ymax / 10), vbGreen
End If
If datano Mod 100 = 99 Then
PictureInitial
End If
End Sub
Private Sub PictureInitial()
Picture1.Cls
Picture1.AutoRedraw = True
Picture1.ForeColor = &HFF00FF
Picture1.BackColor = vbBlack
'scale initial
Picture1.Scale (-300, Picture1.Height / 2)-(Picture1.Width, -Picture1.Height / 2)
xmax = Picture1.Width - 400
ymax = Picture1.Height / 2 - 250
xaxismax = Picture1.Width - 100
yaxismax = Picture1.Height / 2 - 80
'draw x axis
Picture1.Line (-250, 0)-(xaxismax, 0), &HFFFF&
Picture1.Line (xaxismax - 60, 50)-(xaxismax, 0), &HFFFF&
Picture1.Line (xaxismax - 60, -70)-(xaxismax, 0), &HFFFF&
'draw y axis
Picture1.Line (0, yaxismax)-(0, -yaxismax), &HFFFF&
Picture1.Line (-60, yaxismax - 60)-(0, yaxismax), &HFFFF&
Picture1.Line -(60, yaxismax - 60), &HFFFF&
'draw origin,x,y
Picture1.CurrentX = 5: Picture1.CurrentY = -5: Picture1.Print (CInt(datano / 100)) * 100 '(datano / 100) * 100
Picture1.CurrentX = xaxismax - 50: Picture1.CurrentY = -80: Picture1.Print "x"
Picture1.CurrentX = 70: Picture1.CurrentY = yaxismax + 120: Picture1.Print "y"
'draw x number
If total < 10 Then
total = total + 1
For i = 0 To 10 Step 1
    If i <> 0 Then
        Picture1.Line (i * xmax / 10, 20)-(i * xmax / 10, 0), &HFFFF&
        Picture1.CurrentX = i * xmax / 10 - 180: Picture1.CurrentY = -5: Picture1.Print (CInt(datano / 100)) * 100 + i * 10
    End If
Next
Else
    total = 0
End If
'draw y number
For i = -10 To 10 Step 1
    If i <> 0 Then
        Picture1.Line (20, i * ymax / 10)-(0, i * ymax / 10), &HFFFF&
        Picture1.CurrentX = -300: Picture1.CurrentY = i * ymax / 10 + 80: Picture1.Print i
    End If
Next
'initial currentX and currentY
Picture1.CurrentX = 0
Picture1.CurrentY = 0
End Sub
Private Sub cmdclose_Click()
Winsockhost.SendData "s" + CStr(datatype) + "/" + CStr(cycle) + "/f"
Winsockhost.Close
Unload Me
End Sub
Private Sub cmdend_Click()
'send setting information
'the format of setting like this :
'Setting = "s" + CStr(datatype) + " / " + CStr(cycle) + "/t"
'setting = "s" + CStr(datatype) + "/" + CStr(cycle) + "/f"
Winsockhost.SendData "s" + CStr(datatype) + "/" + CStr(cycle) + "/f"
Winsockhost.Close
cmdStart.Enabled = True
cmdend.Enabled = False
txthostPort.Enabled = True
txtclientPort.Enabled = True
txtclientIP.Enabled = True
txtcycle.Enabled = True
cmbdatatype.Enabled = True
Label3.Caption = " 数据采集停止！"
End Sub
Private Sub cmdStart_Click()
cmbdatatype.Enabled = False
txtclientIP.Enabled = False
'check the text of txthostPort is numeric
If IsNumeric(txthostPort.Text) = True Then
    txthostPort.Enabled = False
Else
    MsgBox "请输入正确主机端口!"
    txthostPort.Enabled = True
End If
'check the text of txtclientPort is numeric
If IsNumeric(txtclientPort.Text) = True Then
    txtclientPort.Enabled = False
Else
    MsgBox "请输入正确主机端口!"
    txtclientPort.Enabled = True
End If
'check the text of txtcycle is numeric
If IsNumeric(Trim(txtcycle)) = True Then
    cycle = CInt(Trim(txtcycle.Text))
    txtcycle.Enabled = False
Else
    MsgBox "请在周期文本框里输入整数！"
    txtcycle.Enabled = True
End If
With Winsockhost
    .RemoteHost = txtclientIP.Text
    .RemotePort = txtclientPort.Text
    .Bind txthostPort.Text
End With
'setting the type of data to select
datatype = cmbdatatype.ListIndex
'send setting information
'the format of setting like this :
'SearchString = "s" + CStr(datatype) + " / " + CStr(cycle) + "/t"
'setting = "s" + CStr(datatype) + "/" + CStr(cycle) + "/t"
Winsockhost.SendData "s" + CStr(datatype) + "/" + CStr(cycle) + "/t"
cmdStart.Enabled = False
cmdend.Enabled = True
Label3.Caption = " 数据采集开始！"
End Sub
Private Sub Form_Load()
'load MouseIcon
frmmain.MouseIcon = LoadPicture(App.Path + "\H_point.cur")
frmmain.MousePointer = vbCustom '
Label3.Caption = "请设置主机端口，采样机IP地址及端口,采样数据类型和采样周期！"
'initial grid
Grid1.TextMatrix(0, 0) = "采样号"
Grid1.TextMatrix(0, 1) = "采样值"
'database initial
Dim sqltext As String
Set dbrst = New adodb.Recordset
Set dbrst.ActiveConnection = conn
Set conn = New adodb.Connection
conn.ConnectionString = "dbq=" + App.Path + "\database1;driver={microsoft access driver (*.mdb)};driverid=25；fil=ms access;"
conn.Open
Set dbrst = New adodb.Recordset
Set dbrst.ActiveConnection = conn
'datatype , cycle and datano initial
datatype = 0
cycle = 100
datano = 0
no = 0
flag = 0
'control initial
txthostIP = Winsockhost.LocalIP
txthostIP.Enabled = False
txthostPort = 1001
txtclientIP = ""
txtclientPort = 1002
txtcycle = cycle
cmbdatatype.ListIndex = datatype
'picture initial
PictureInitial
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set dbrst = Nothing
conn.Close
End Sub

Private Sub Winsockhost_DataArrival(ByVal bytesTotal As Long)
Dim SearchString As String
Dim i As Integer
Winsockhost.GetData SearchString
'receive data,the formation of the data like this:
'SearchString = "i" + CStr(datano) + " / " + CStr(datavalue) + "/"
txt.Text = SearchString
If Left(txt.Text, 1) = "i" Then
    no = no + 1
    txt.SelStart = InStr(txt.Text, "i")
    i = InStr(txt.Text, "/")
    txt.SelLength = i - txt.SelStart - 1
    datano = CLng(txt.SelText)
    txtdatano.Text = datano
    txt.SelStart = i + 1
    txt.SelLength = InStr(i + 1, txt.Text, "/") - txt.SelStart - 1
    a = CSng(txt.SelText)
    datavalue = a
    txtdatavalue.Text = a
    If datano > 1000 Then
       ' datano = 0
    End If
    If flag = 0 Then
        flag = 1
        Picture1.Cls
        PictureInitial
    End If
    If datano Mod 100 = 0 Then
        Picture1.Cls
        PictureInitial
    End If
    draw
    AddData
    refreshgrid
End If
End Sub