form1.frm

地面测试仪

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin MSComctlLib.ProgressBar ProgressBar1 
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   2460
      Width           =   3915
      _ExtentX        =   6906
      _ExtentY        =   450
      _Version        =   393216
      Appearance      =   1
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   2760
      Top             =   600
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin VB.CommandButton Command2 
      Caption         =   "地面仪通讯"
      Height          =   495
      Left            =   360
      TabIndex        =   1
      Top             =   660
      Width           =   2235
   End
   Begin VB.CommandButton Command1 
      Caption         =   "验封40to60"
      Height          =   495
      Left            =   540
      TabIndex        =   0
      Top             =   1680
      Width           =   3195
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Command1_Click()
Dim sFileNum As Integer, dFileNum As Integer
Dim strsFileName As String, strdFileName As String
Dim rcount As Long
Dim strTemp As String
Dim i As Integer, j As Integer, k As Integer
Dim tempData() As Single
sFileNum = FreeFile()

strsFileName = "E:\Program Files\哈尔滨贝可赛软件开发销售有限公司\BKS电子压力验封仪系统应用软件\数据\01234200707123.dat"
strdFileName = "c:\0123420070726.dat"
k = 0
Open strsFileName For Input As sFileNum
    dFileNum = FreeFile()
    Open strdFileName For Output As dFileNum
        
        For i = 1 To 24
            Line Input #sFileNum, strTemp
            Print #dFileNum, strTemp
            If i = 23 Then
                rcount = CLng(Mid(strTemp, InStr(1, strTemp, "=") + 1))
            End If
        Next
        
        ReDim tempData(rcount, 3)
        For i = 0 To rcount - 1
            '读取
            Line Input #sFileNum, strTemp
            
            For j = 0 To 3
                tempData(i, j) = Val(Mid(strTemp, 8 + (j * 15), 15))
            Next
            '转换
            Select Case True
            Case tempData(i, 2) > 23 And tempData(i, 2) <= 27 '25----30
                tempData(i, 2) = 30 + RandXs
                tempData(i, 3) = 30 + RandXs
            Case tempData(i, 2) > 27 And tempData(i, 2) <= 32 '30----40
                tempData(i, 2) = 40 + RandXs
                tempData(i, 3) = 40 + RandXs
            Case tempData(i, 2) > 32 And tempData(i, 2) <= 37 '35----50
                tempData(i, 2) = 50 + RandXs
                tempData(i, 3) = 50 + RandXs
            Case tempData(i, 2) > 37 And tempData(i, 2) <= 42 '35----50
                tempData(i, 2) = 60 + RandXs
                tempData(i, 3) = 60 + RandXs
            Case Else
            End Select
            
            
            
            '保存
            Randomize
            If Int(1000 * Rnd) = 60 Then
                k = k + 1
            
            Else
                strTemp = strFormat(CStr(i + 1 - k), "0", 7)
                For j = 0 To 3
                   strTemp = strTemp & strFormat(CStr(tempData(i, j)), Chr(32), 15)
                Next
                Print #dFileNum, strTemp
            
            End If
        Next
        Print #dFileNum, CStr(rcount - k)
    
    Close dFileNum
Close sFileNum
MsgBox "end"
End Sub



Function RandXs() As Single
Dim intFlag As Integer
Dim tempData As Single
Randomize
intFlag = Int((2 * Rnd + 1))
Randomize
tempData = Round((400 * Rnd + 1) / 10000, 4)
If intFlag = 1 Then
    RandXs = 0 - tempData
Else
    RandXs = 0 + tempData
End If



End Function

Function myComm(comport As Integer) As Byte()


End Function