main.frm

使用的是最小误差法的插补程序

'菜单选择，系统标定、系统运行、数据管理
Private Sub clfile_Click(Index As Integer)
Select Case Index
    Case 1
        pass.Show
    Case 4
        Call CmdRun_Click         '系统运行
    Case 5
        Call CmdSearch_Click      '数据管理
    Case 6
        Unload Me
End Select
End Sub
'菜单选择，参数设置、系统调试
Private Sub clfile1_Click(Index As Integer)
Select Case Index
    Case 1
        Call Shell(App.Path & "\rastrul.exe", vbNormalFocus)
    Case 2
        Load frmTest
        frmTest.Show
End Select
End Sub

'数据管理
Private Sub CmdSearch_Click()
frmOptions.Show , Me
End Sub

'系统停止运行
Private Sub CmdStop_Click()
Timer1.Enabled = True
SystemRun = False
Call outportb(BaseAddrIO, &H0)
Call outportb(BaseAddrIO + 1, &H0)
clJian.Caption = "系统已停止"
clJian.FontSize = 20
Frame3.Caption = ""
End Sub

Private Sub Form_Activate()
Call Screen
End Sub

Private Sub Form_Load()
Dim OldBianhao As String         '上一个编号
Dim NewBianhao As String         '新编号
Dim i As Integer

AllPlus = 360                     '主轴角度
UpPlus = 30
DownPlus = 330

Call para_Read       '读取参数至内存变量

AllPlus = AllPlus / StepAngle      '主轴脉冲数
UpPlus = UpPlus / StepAngle
DownPlus = DownPlus / StepAngle

Steps = CInt(AllPlus)

'openDirectIO (0)


NewBianhao = CreateBianHao      '生成编号
OldBianhao = NewBianhao
tableNames = Left(NewBianhao, 4)
Call PanExist(tableNames)    '判断表是否存在
If flagExist = 1 Then
    Call Product(tableNames)   '新建表
    If adoProduct.RecordCount <> 0 Then
        adoProduct.MoveLast
        OldBianhao = adoProduct![编号]
    End If
End If

If Left(OldBianhao, 7) = Left(NewBianhao, 7) And flagExist = 1 Then
    ProNumber = CInt(Right(OldBianhao, 4))
    Call CountNumber(Left(OldBianhao, 7))
    For i = 1 To 5
        Counter(i) = gradeNum(i - 1)
    Next i
Else
    ProNumber = 0
    For i = 1 To 5
        Counter(i) = 0
    Next i
End If
For i = 1 To 5
   clTong(i - 1).Caption = Format(Counter(i), "000")
Next i

clTong(5).Caption = Format(ProNumber, "0000")

'初始化5个通道地址到数组ChnAddr(1 to 4)
For i = 1 To 4
        RasterAddr(i) = BaseAddrScale + (i - 1) * 4
Next i
NoBiaoDing = True
clJian.Caption = "系统尚未启动"
clJian.FontSize = 20
clJian.Top = 360
Frame3.Caption = ""

Call outportb(BaseAddrIO, &H0)                    '系统初始化
Call outportb(BaseAddrIO + 1, &H0)

End Sub
'求最大值函数
Private Function max(x As Single, y As Single) As Single
If x > y Then
    max = x
Else
max = y
End If
End Function
'求最小值函数
Private Function min(x As Single, y As Single) As Single
If x < y Then
    min = x
Else
min = y
End If
End Function
'系统运行函数
Private Sub CmdRun_Click()
Dim i As Integer                   '循环变量
Dim j As Integer, k As Integer
Dim cta As Integer
Dim dcta As Single
Dim f As Long     '运行频率（Hz）

Dim NewBanNumber As Byte            '新班次
Dim OldBanNumber As Byte            '旧班次

Do          '多工件循环检测

    SystemRun = True
    OldBanNumber = CreatBanNumber()
    
    clJian.Caption = "请安装工件"
    clJian.Top = 390
    Frame3.Caption = ""
    
    '读启动按纽
    Do
        DoEvents
    Loop Until IsStart = 1
    
    Timer1.Enabled = False
    
    PicDuan.Cls
    PicJing.Cls
    Call Screen
    
    clJian.Caption = "正在夹紧工件…"
    clJian.FontSize = 18
    clJian.Top = 390
    Frame3.Caption = ""
    
    '夹紧通电
    Call Clamp
    
    sleep (2000)
    
    clJian.Caption = "工件已夹紧，测头正在前进……"
    clJian.FontSize = 15
    clJian.Top = 290
    Frame3.Caption = ""
    
    '测头前进
    Call ForwardExam
    
    sleep (3000)
    
    clJian.Caption = "测头已到位，马上启动主轴"
    clJian.FontSize = 16
    clJian.Top = 290
    Frame3.Caption = ""
       
    'MsgBox "清零"
    
    '光栅计数器清零
    For i = 1 To 4
        'Call ClearCounter(RasterAddr(i), &H0)
        Call ResetAll(RasterAddr(i), &H0)
    Next i
    
    'StartAxis (StopPlus)  '启动主轴
    
    clJian.Caption = "主轴已启动到零位,开始检测……"
    clJian.FontSize = 15
    clJian.Top = 290
    clJian.Height = 600
    Frame3.Caption = ""
    
    clJian.Caption = "正在检测……"
    clJian.FontSize = 20
    clJian.Top = 390
    Frame3.Caption = ""
    
    PicJing.AutoRedraw = False
    PicDuan.AutoRedraw = False
    
    '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
    '''''''''''''''''''''''''''''cta=0''''''''''''''''''''''''''''''
    cta = 0
        If SystemRun = False Then
            Exit Sub
        End If
        '测四路跳动瞬时值,并分别赋值给Shun(cta,1),Shun(cta,2),Shun(cta,3),shun(cta,4)
        Shun(cta, 1) = ReadCounter(&H350) / 200         '上端跳
        Shun(cta, 2) = ReadCounter(&H350 + 4) / 200     '上径跳
        Shun(cta, 3) = ReadCounter(&H350 + 8) / 200     '下径跳
        Shun(cta, 4) = ReadCounter(&H350 + 12) / 200    '下端跳
            
        DoEvents
            
        '得到最大最小值
        For i = 1 To 4
            MyMax(i) = Shun(cta, i)
            MyMin(i) = Shun(cta, i)
            '数值显示
            Call DisplayData(Shun(cta, i), i - 1, 1)
            Call DisplayData(MyMax(i) - MyMin(i), i - 1, 2)
        Next i
        
        If cta > 0 Then
            '曲线显示
            For i = 1 To 4
                Call DrawLine(cta * StepAngle, Shun((cta - 1) * StepAngle, i), Shun(cta * StepAngle, i), i)
            Next i
            '圆度显示
            'Call DrawRadius1((cta - 1) * StepAngle / DownRate, cta * StepAngle / DownRate, Shun(cta - 1, 2), Shun(cta, 2)) '上径跳
            'Call DrawRadius2((cta - 1) * StepAngle / DownRate, cta * StepAngle / DownRate, Shun(cta - 1, 3), Shun(cta, 3)) '下径跳
        End If
            
        f = f0 + a1 * cta
        plus = 1000 / f
        Call StartAxis(plus)
    
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '''''''''''''''''''''''''''''cta=1''''''''''''''''''''''''''''''
    cta = 1
        If SystemRun = False Then
            Exit Sub
        End If
        '测四路跳动瞬时值,并分别赋值给Shun(cta,1),Shun(cta,2),Shun(cta,3),shun(cta,4)
        Shun(cta, 1) = ReadCounter(&H350) / 200         '上端跳
        Shun(cta, 2) = ReadCounter(&H350 + 4) / 200     '上径跳
        Shun(cta, 3) = ReadCounter(&H350 + 8) / 200     '下径跳
        Shun(cta, 4) = ReadCounter(&H350 + 12) / 200    '下端跳
        
        DoEvents
        
        '得到最大最小值
        For i = 1 To 4
            MyMax(i) = max(MyMax(i), Shun(cta, i))
            MyMin(i) = min(MyMin(i), Shun(cta, i))
            '数值显示
            Call DisplayData(Shun(cta, i), i - 1, 1)
            Call DisplayData(MyMax(i) - MyMin(i), i - 1, 2)
        Next i
        
        If cta > 0 Then
            '曲线显示
            For i = 1 To 4
                Call DrawLine(cta * StepAngle, Shun((cta - 1) * StepAngle, i), Shun(cta * StepAngle, i), i)
            Next i
            '圆度显示
            'Call DrawRadius1((cta - 1) * StepAngle / DownRate, cta * StepAngle / DownRate, Shun(cta - 1, 2), Shun(cta, 2)) '上径跳
            'Call DrawRadius2((cta - 1) * StepAngle / DownRate, cta * StepAngle / DownRate, Shun(cta - 1, 3), Shun(cta, 3)) '下径跳
        End If
            
        f = f0 + a1 * cta
        plus = 1000 / f
        Call StartAxis(plus)
    
    
    ''''''''''''''''''''''''''''2<cta<Steps''''''''''''''''''''''''''''''''
    For cta = 2 To Steps      '步进电机步数
        If SystemRun = False Then
            Exit Sub
        End If
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        '测四路跳动瞬时值,并分别赋值给Shun(cta,1),Shun(cta,2),Shun(cta,3),shun(cta,4)
        Shun(cta, 1) = ReadCounter(&H350) / 200         '上端跳
        Shun(cta, 2) = ReadCounter(&H350 + 4) / 200     '上径跳
        Shun(cta, 3) = ReadCounter(&H350 + 8) / 200     '下径跳
        Shun(cta, 4) = ReadCounter(&H350 + 12) / 200    '下端跳
    
        DoEvents
                    
        Call Eliminate(cta)                '从第三项cta=2开始剔除奇异项
                        
        '得到最大最小值
        For i = 1 To 4
            MyMax(i) = max(MyMax(i), Shun(cta, i))
            MyMin(i) = min(MyMin(i), Shun(cta, i))
            '数值显示
            Call DisplayData(Shun(cta, i), i - 1, 1)
            Call DisplayData(MyMax(i) - MyMin(i), i - 1, 2)
            '曲线显示
            Call DrawLine(cta * StepAngle, Shun((cta - 1) * StepAngle, i), Shun(cta * StepAngle, i), i)
        Next i
        
        'Call DrawRadius1((cta - 1) * StepAngle, cta * StepAngle, Shun(cta - 1, 2), Shun(cta, 2))   '上径跳
        'Call DrawRadius2((cta - 1) * StepAngle, cta * StepAngle, Shun(cta - 1, 3), Shun(cta, 3))   '下径跳
    
        If (cta < UpPlus) Then                      '加速
            f = f0 + a1 * cta
        ElseIf (cta < DownPlus) Then                '匀速
            f = f1
        ElseIf (cta <= AllPlus) Then                 '减速
            f = f1 - a1 * (cta - DownPlus)
        Else
            MsgBox "System Error!"
        End If
        
        plus = 1000 / f
        Call StartAxis(plus)
        
    Next cta
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'MsgBox "end"
    
    Timer1.Enabled = True
    
    PicJing.AutoRedraw = True
    PicDuan.AutoRedraw = True
    
    Call StopAxis                 '停止
    Call QuitExam                 '测头退出  '退到位时,硬件切断测头退
    sleep (200)
    Call Loosen                   '夹具松开
    
    'For cta = 0 To Steps    '步进电机步数
        'DoEvents
    '    For i = 1 To 4
    '        '曲线显示
    '        Call DrawLine(cta * StepAngle, Shun((cta - 1) * StepAngle, i), Shun(cta * StepAngle, i), i)
            
            'If cta > 1 Then
            'Call DrawRadius1((cta - 1) * StepAngle, cta * StepAngle, Shun(cta - 1, 2), Shun(cta, 2))   '上径跳
            'Call DrawRadius2((cta - 1) * StepAngle, cta * StepAngle, Shun(cta - 1, 3), Shun(cta, 3))   '下径跳
            'End If
    '    Next i
    'Next cta
    
    'frmDrawRadius.Show
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
    
    'Jumper2:
    'Call DoData                    '数据拟和，插值
    'Call JudgeMaxMin                '求最大值、最小值、跳动量
    'For i = 1 To 4
    '    Call DisplayData(jump(i), i - 1, 2)        '更新跳动量
    'Next i
    
    'Grade = GetGrade(max(jump(1), jump(4)), max(jump(2), jump(3)))
    'DoEvents
    Grade = GetGrade(max(MyMax(1) - MyMin(1), MyMax(4) - MyMin(4)), max(MyMax(2) - MyMin(2), MyMax(3) - MyMin(3)))
    
    bianhao = CreateBianHao
    
    NewBanNumber = CByte(Mid(CStr(bianhao), 7, 1))
    If NewBanNumber <> OldBanNumber Then
        Call ClearZero
    End If
    OldBanNumber = NewBanNumber
    Call Display(Grade)           '显示判定结果、统计结果等
    
    '将测到的瞬时数据写入文件
    'Open App.Path & "\systemerror.dat" For Output As #2
    '    For cta = 0 To Steps
    '        For i = 1 To 4
    '            SystemError(cta, i) = Shun(cta, i)
    '        Next i
    '        Print #2, Shun(cta, 1), Shun(cta, 2), Shun(cta, 3), Shun(cta, 4) '保存系统误差
    '    Next cta
    'Close #2
    
    '数据存入数据库
    Dim CuDate As String   '取当前的日期
    CuDate = Date
    CuDate = Format(CuDate, "yymm")
    tableNames = CuDate
    Call PanExist(CuDate)   '判断表是否存在
    If flagExist = 1 Then
        Call superAdd(tableNames) '如果表存在则追加数据
    ElseIf flagExist = 0 Then
        Call tableBuild(tableNames) '如果表不存在则建新表
        Call superAdd(tableNames)   '然后再追加数据
    End If
    
    'PicDuan.Cls
    'PicJing.Cls
    
    '显示拟和后曲线
    'For cta = 0 To 359
    '    For i = 1 To 4
    '        Call DrawLine(cta + 1, Shun(cta + 3, i), Shun(cta + 4, i), i)
    '    Next i
    'Next cta
    
    Call Led(Grade)
    clJian.Caption = "检测完毕"
    
Loop

End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Private Sub Timer1_Timer()
Main.LabTime.Caption = Time & " " & Date
Main.LabTime.FontSize = 15
End Sub