test.frm

电动平台, 控制X,Y,Z轴移动,能计数

    FrmPattern.DoPattern Xpos, Ypos
End Sub

Private Sub BtnRight_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        myStage.MoveRight XMoveDistance
    ElseIf Button = vbRightButton Then
        GetMoveDistance (0)
    End If
End Sub

Private Sub BtnShutter_Click(Index As Integer)
    Dim temp As Boolean
    If InStr(BtnShutter(Index).Caption, "Open") Then
        myScan.IsShutterOpen(Index + 1) = True
        BtnShutter(Index).Caption = "Close" & Right(BtnShutter(Index).Caption, 10)
    Else
        myScan.IsShutterOpen(Index + 1) = False
        BtnShutter(Index).Caption = "Open" & Right(BtnShutter(Index).Caption, 10)
    End If
    
   ' temp = myScan.IsShutterOpen(Index + 1)
End Sub

Private Sub BtnUp_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  
   
   If Button = vbLeftButton Then
        myFocus.MoveUp ZMoveDistance
    ElseIf Button = vbRightButton Then
        GetMoveDistance (2)
    End If
    
End Sub
Private Sub Connect(port As Long)
    Dim v As Long
    Dim MySettings As Variant, intSettings As Integer
    
    Set myScan = CreateObject("Prior.Scan")
    myScan.Connect port

   If port = 0 Then
        myScan.GetPowerSupplyVoltage v
        If v < 11 Then
            rc = MsgBox("The Power Supply Voltage is Low " & v & " V", vbOKOnly + vbCritical, "Error Message")
            Set myScan = Nothing
            End
        End If
        Volts.Text = v & " V"
        PCIBoard = True
    ElseIf port > 0 Then
        PCIBoard = False
        Temperature.Visible = False
        Volts.Visible = False
        Label2.Visible = False
        Label3.Visible = False
    Else
        MsgBox "Connection Failed Error " & port
        SaveSetting App.Title, "Connect", "Port", port
        myScan.DisConnect
        Set myScan = Nothing
        End
    End If

    Set myEncoder = CreateObject("Prior.Encoders")
    Set myStage = CreateObject("Prior.Stage")
    Set myFocus = CreateObject("Prior.Z")
    Set myFilter = CreateObject("Prior.Filter")
    Set myTTL = CreateObject("Prior.Ttl")
    Set myPiezo = CreateObject("Prior.Piezo")
End Sub


Private Sub CmdYFilter_Click()
    myFilter.SetYaxisAsFilter 4, 0, 0, 0
    Unload FormFilter2
    BtnBackLeft.Visible = False
    BtnBack.Visible = False
    BtnBackRight.Visible = False
    BtnForwardLeft.Visible = False
    BtnForward.Visible = False
    BtnForwardRight.Visible = False
    FormFilter2.Show
End Sub

Private Sub DRO_X_Click()
    Dim temp As Variant
    
    temp = InputBox("Please enter the new X Position in microns", "Stage X Position", myStage.XPosition)
    If IsNumeric(temp) = True Then myStage.XPosition = temp
End Sub
Private Sub DRO_Y_Click()
    Dim temp As Variant
    
    temp = InputBox("Please enter the new Y Position in microns", "Stage Y Position", myStage.YPosition)
    If IsNumeric(temp) = True Then myStage.YPosition = temp
End Sub
Private Sub DRO_z_Click()
    Dim temp As Variant
    
    temp = InputBox("Please enter the new Focus Position in microns", "Focus Position", myFocus.Position)
    If IsNumeric(temp) = True Then myFocus.Position = temp
End Sub

Private Sub SetUpShutters()
    Dim sh1 As Long
    Dim sh2 As Long
    Dim sh3 As Long
    Dim temp As Long
    
    myScan.GetShuttersPresent sh1, sh2, sh3


    If sh1 = 1 Then
        If myScan.IsShutterOpen(1) = 1 Then
            BtnShutter(0).Caption = "Close Shutter A"
        Else
            BtnShutter(0).Caption = "Open Shutter A"
        End If
    End If
    
    BtnShutter(0).Visible = IsTrue(sh1)
    
    If sh2 = 1 Then
        If myScan.IsShutterOpen(2) = 1 Then
            BtnShutter(1).Caption = "Close Shutter B"
        Else
            BtnShutter(1).Caption = "Open Shutter B"
        End If
    End If
    
    BtnShutter(1).Visible = IsTrue(sh2)
    
    If sh3 = 1 Then
        temp = myScan.IsShutterOpen(3)
        If temp = 1 Then
            BtnShutter(2).Caption = "Close Shutter C"
        Else
            BtnShutter(2).Caption = "Open Shutter C"
        End If
    End If
    
    BtnShutter(2).Visible = IsTrue(sh3)
   
    
    If sh1 Or sh2 Or sh3 Then
        ShuttersFilters = ShutterFilters + 1
    End If
    
    
    
End Sub

Private Sub MnuFocusServoEnable_Click()
    If MnuFocusServoEnable.Checked Then
        MnuFocusServoEnable.Checked = False
        myEncoder.ZServoEnable = 0
    Else
        MnuFocusServoEnable.Checked = True
        myEncoder.ZServoEnable = 1
    End If
End Sub

Private Sub mnuStage_Click()

    Dim stageType As Long
    Dim stageX As Long
    Dim stageY As Long
    Dim uStepsPerMicron As Long
    Dim openLimits As Long
    Dim stageDesc As String
    
    myStage.GetParams stageType, stageDesc, stageX, stageY, uStepsPerMicron, openLimits
    
    frmStage.txtStage = Str(stageType)
    frmStage.lstLimits.ListIndex = openLimits
    frmStage.txtType = stageDesc
    frmStage.txtXtravel = stageX
    frmStage.txtYTravel = stageY
    frmStage.txtMicro = uStepsPerMicron

    frmStage.Top = TestControl.Top + 400
    frmStage.Left = TestControl.Left + 960
    frmStage.Visible = True
    


End Sub

Private Sub mnuStageEncoderWindow_Click()
    temp = InputBox("Enter Stage Encoder Window in Encoder Counts", _
        "Stage Encoder", myEncoder.XEncoderWindow)
    If IsNumeric(temp) Then
        myEncoder.XEncoderWindow = temp
        myEncoder.YEncoderWindow = temp
    End If
End Sub

Private Sub mnuStageServoWindow_Click()
    temp = InputBox("Enter Stage Servo Window in microns", _
        "Stage Servo", myEncoder.StageServoWindow)
    If IsNumeric(temp) Then myEncoder.StageServoWindow = temp
End Sub

Private Sub mnuTTL_Click()
    FrmTTL.Show
End Sub
Private Sub mnuFocusMicronsPerMotorRev_Click()
temp = InputBox("Enter focus microns/motor rev", _
        "microns/rev", myFocus.MicronsPerMotorRevolution)
    If IsNumeric(temp) Then myFocus.MicronsPerMotorRevolution = temp
End Sub

Private Sub mnuZServoWindow_Click()
temp = InputBox("Enter Focus Servo Window in microns", _
        "Focus Servo", myEncoder.ZServoWindow)
    If IsNumeric(temp) Then myEncoder.ZServoWindow = temp
End Sub
Private Sub SetUpEncoders()
    
     If myEncoder.IsXFitted And myEncoder.IsYFitted Then
        LblEncX.Visible = True
        LblEncY.Visible = True
        
        MnuStageEncEnable.Enabled = True
        mnuStageServo.Enabled = True
        mnuStageServoWindow.Enabled = True
        mnuStageEncoderWindow.Enabled = True
        mnuXres.Enabled = True
        MnuYres.Enabled = True
        If (myEncoder.XEnable And myEncoder.YEnable) Then
            MnuStageEncEnable.Checked = True
        Else
            MnuStageEncEnable.Checked = False
        End If
        
        mnuStageServo.Checked = IsTrue(myEncoder.StageServoEnable)
    Else
        LblEncX.Visible = False
        LblEncY.Visible = False
        MnuStageEncEnable.Enabled = False
        mnuStageServo.Enabled = False
        mnuStageServoWindow.Enabled = False
        mnuStageEncoderWindow.Enabled = False
        mnuXres.Enabled = False
        MnuYres.Enabled = False
        
    End If
    
    If myEncoder.IsZFitted Then
        LblEncZ.Visible = True
        MnuFocusEncEnable.Enabled = True
        MnuFocusServoEnable.Enabled = True
        mnuFocusEncoderWindow.Enabled = True
        mnuZServoWindow.Enabled = True
        MnuZres.Enabled = True
        
        MnuFocusEncEnable.Checked = IsTrue(myEncoder.ZEnable)
        MnuFocusServoEnable.Checked = IsTrue(myEncoder.ZServoEnable)
    Else
        LblEncZ.Visible = False
        MnuFocusEncEnable.Enabled = False
        MnuFocusServoEnable.Enabled = False
        mnuFocusEncoderWindow.Enabled = False
        mnuZServoWindow.Enabled = False
        MnuZres.Enabled = False
       
    End If
    
    If myEncoder.IsXFitted Or myEncoder.IsYFitted Or myEncoder.IsZFitted Then
        MnuEncoders.Enabled = 1
    Else
        MnuEncoders.Enabled = 0
    End If
    
    
End Sub

Public Function IsTrue(value As Long) As Boolean

    If value Then
        IsTrue = True
    Else
        IsTrue = False
    End If
End Function

Public Function IsChecked(value As Boolean) As Long

    If value Then
        IsChecked = 1
    Else
        IsChecked = 0
    End If
End Function

Private Sub SetupBacklash()
        
    MnuStageBacklashEnable.Checked = IsTrue(myStage.HostBackLashEnable)
    MnuStageJoyBackEnable.Checked = IsTrue(myStage.JoystickBacklashEnable)
    MnuFocusBackLashEnable.Checked = IsTrue(myFocus.HostBackLashEnable)
    MnuFocusJoyBackEnable.Checked = IsTrue(myFocus.JoystickBacklashEnable)

End Sub

Private Sub SetupSpeed()
    
 '   If PCIBoard Then
        'dont do this as it turns GUI joystick off if physical stick
        'not connected to PCI card
        'MnuJoyEnable.Checked = IsTrue(myStage.JoystickEnable)
 '   Else
        'always enable joystick on proscan
''        MnuJoyEnable.Checked = True
'        MnuJoyEnable.Enabled = False
'        myStage.JoystickEnable = True
'    End If
        
    If myStage.XJoystickDirection < 0 Then
        MnuJoyXRev.Checked = True
    Else
        MnuJoyXRev.Checked = False
    End If

    If myStage.YJoystickDirection < 0 Then
        MnuJoyYRev.Checked = True
    Else
        MnuJoyYRev.Checked = False
    End If
    
    If myStage.XHostDirection < 0 Then
        mnuHostXReverse.Checked = True
    Else
        mnuHostXReverse.Checked = False
    End If
    
    If myStage.YHostDirection < 0 Then
        mnuHostYReverse.Checked = True
    Else
        mnuHostYReverse.Checked = False
    End If
End Sub
Private Sub SetupCorrection()
    mnu4Point.Checked = IsTrue(myStage.CorrectionEnable)
    mnuMapping.Checked = IsTrue(myStage.MappingEnabled)
    mnuSkewEnabled.Checked = IsTrue(myStage.SkewEnabled)
End Sub
 
Private Sub SetUpFilters()
    Dim f1, f2, f3 As Boolean
    
    f1 = IsTrue(myFilter.PositionsPerWheel(1))
    f2 = IsTrue(myFilter.PositionsPerWheel(2))
    f3 = IsTrue(myFilter.PositionsPerWheel(3))

    BtnFW1.Visible = f1
    BtnFW2.Visible = f2
    BtnFW3.Visible = f3

    'If ((myFilter.PositionsPerWheel(2) > 0) Or (myFilter.PositionsPerWheel(3) > 0) = True) Then
    '    CmdYFilter.Visible = False
    'Else
    '    CmdYFilter.Visible = True
    'End If
    
    If f1 Or f2 Or f3 Then
        ShuttersFilters = ShuttersFilters + 1
    End If
    
End Sub
Private Sub Form_Load()
    Dim port As Long
    Dim temp As Variant
    Dim appPath As String

    Left = Val(GetSetting(App.Title, "MainFrm", "left", Left))
    Top = Val(GetSetting(App.Title, "MainFrm", "top", Top))
    If Left < 0 Then Left = 0 'just make sure app isn't off the screen
    If Top < 0 Then Top = 0
    If Left > Screen.Width - Me.Width Then Left = Screen.Width - Me.Width
    If Top > Screen.Height - Me.Height Then Top = Screen.Height - Me.Height
    Me.Left = Left
    Me.Top = Top
    
    MoveDistance = 1000
    ZMoveDistance = 100

    MnuKeepDevice.Checked = GetSetting(App.Title, "Device", "Keep", True)
    port = GetSetting(App.Title, "Connect", "Port", -1)
    If port < 0 Then
        temp = InputBox("Please enter the COM Port or 0 for PCI", "Port Selection", 0)
        If IsNumeric(temp) <> True Then End
        port = temp
    ElseIf MnuKeepDevice.Checked Then
    Else
        temp = InputBox("Please enter the COM Port or 0 for PCI", "Port Selection", port)
        If IsNumeric(temp) <> True Then End
        port = temp
    End If
    
    XMoveDistance = GetSetting(App.Title, "Distance", "X", 1000)
    YMoveDistance = GetSetting(App.Title, "Distance", "Y", 1000)
    ZMoveDistance = GetSetting(App.Title, "Distance", "Z", 10)
    
    Connect port
    SaveSetting App.Title, "Connect", "Port", port
    
    ShuttersFilters = 0
    
    SetupBacklash
    SetUpShutters
    SetUpFilters
    SetUpEncoders
    SetupCorrection
    SetupSpeed
    
  
    'MnuJoyEnable.Checked = True
    'myStage.JoystickEnable = True
     
    MnuJoyEnable.Checked = IsTrue(myStage.JoystickEnable)
    
    If MnuJoyEnable.Checked = False Then
        ' find out if the real joystick is there or not!
        myStage.JoystickEnable = True
        
        MnuJoyEnable.Checked = IsTrue(myStage.JoystickEnable)
        
        If MnuJoyEnable.Checked = False Then
            ' no its not there so tick the box anyway so we can use the GUI
            MnuJoyEnable.Checked = True
        Else
            ' physical stick is there but its been disabled
           myStage.JoystickEnable = False
        End If
    End If
    
    If ShuttersFilters = 2 Then
        chkShutters.value = myFilter.CloseShutterDuringMove
    Else
        chkShutters.Visible = False
    End If
    
    myFocus.MaxSpeed = 250
    
    
     
    TemperatureCount = 0
    Timer1.Enabled = True
    
    App.HelpFile = "C:\Program Files\Prior Scientific\Components\Prior Dll Help.chm"
End Sub
Private Sub Form_Unload(Index As Integer)
    'save trivial settings
    If Me.WindowState = vbDefault Then
        Call SaveSetting(App.Title, "MainFrm", "left", Me.Left)
        Call SaveSetting(App.Title, "MainFrm", "top", Me.Top)
    End If
    FrmFocus.Form_Unload (0)
    FormJoyStick.Form_Unload (0)
    Timer1.Enabled = False
    myScan.DisConnect
    Set myScan = Nothing
    Set myEncoder = Nothing
    Set myStage = Nothing
    Set myFocus = Nothing
    Set myFilter = Nothing
    Set myTTL = Nothing
    End
End Sub

Private Sub MnuAbout_Click()
    frmAbout.Show vbModal
End Sub
Private Sub MnuClear_Click()
    On Error GoTo TrapError
    DeleteSetting App.Title, "Distance"
    DeleteSetting App.Title, "Connect"
    DeleteSetting App.Title, "MainFrm"
    DeleteSetting App.Title, "Pattern"
    DeleteSetting App.Title, "Dig"
    DeleteSetting App.Title, "Joy"
    Exit Sub
TrapError: