mainfrm.frm

数控切割控制系统,需要DLPORTIO,通过控制8位的并口的电位高低来4路控制数控切割机

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form MainFrm 
   BackColor       =   &H00FFC0C0&
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   7200
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   9600
   LinkTopic       =   "Form1"
   ScaleHeight     =   7200
   ScaleWidth      =   9600
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.Timer updownTimer 
      Enabled         =   0   'False
      Interval        =   10
      Left            =   7380
      Top             =   4680
   End
   Begin VB.Frame Frame1 
      Caption         =   "切割机移位"
      Height          =   2835
      Left            =   6600
      TabIndex        =   14
      Top             =   720
      Width           =   2655
      Begin VB.CommandButton Command3 
         Caption         =   "切割机停止上下(F9)"
         Height          =   435
         Left            =   360
         TabIndex        =   17
         Top             =   2100
         Width           =   1995
      End
      Begin VB.CommandButton Command2 
         Caption         =   "切割机上升(F8)"
         Height          =   495
         Left            =   300
         TabIndex        =   16
         Top             =   1200
         Width           =   1935
      End
      Begin VB.CommandButton Command1 
         Caption         =   "切割机下降(F7)"
         Height          =   495
         Left            =   300
         TabIndex        =   15
         Top             =   480
         Width           =   1935
      End
   End
   Begin VB.PictureBox Picture1 
      Height          =   675
      Left            =   180
      ScaleHeight     =   615
      ScaleWidth      =   9195
      TabIndex        =   9
      Top             =   5880
      Width           =   9255
      Begin VB.Label LblAy 
         Caption         =   "0毫米"
         Height          =   255
         Left            =   4740
         TabIndex        =   13
         Top             =   180
         Width           =   4335
      End
      Begin VB.Label Label5 
         Caption         =   "Ay = "
         Height          =   315
         Left            =   4320
         TabIndex        =   12
         Top             =   180
         Width           =   555
      End
      Begin VB.Label LblAx 
         Caption         =   "0毫米"
         Height          =   315
         Left            =   480
         TabIndex        =   11
         Top             =   180
         Width           =   3795
      End
      Begin VB.Label Label3 
         Caption         =   "Ax ="
         Height          =   315
         Left            =   60
         TabIndex        =   10
         Top             =   180
         Width           =   435
      End
   End
   Begin VB.CommandButton AdjustCmd 
      Caption         =   "校准(F6)"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   2940
      TabIndex        =   8
      Top             =   5160
      Width           =   2955
   End
   Begin MSComDlg.CommonDialog prmDlg 
      Left            =   480
      Top             =   3900
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      Filter          =   "*.prm|*.prm"
   End
   Begin MSComDlg.CommonDialog Dlg 
      Left            =   1440
      Top             =   4860
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      Filter          =   "*.prm|*.prm|All Files|*.*"
   End
   Begin VB.CommandButton EditPrgmCmd 
      Caption         =   "编辑程序(F5)"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   4560
      TabIndex        =   7
      Top             =   3780
      Width           =   2295
   End
   Begin VB.CommandButton AddPrgmCmd 
      Caption         =   "新建程序(F4)"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   2040
      TabIndex        =   5
      Top             =   3780
      Width           =   2295
   End
   Begin VB.CommandButton PrgControlCmd 
      Caption         =   "程序切割(F3)"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   2700
      TabIndex        =   4
      Top             =   2400
      Width           =   3495
   End
   Begin VB.CommandButton DirectCmd 
      Caption         =   "直线多头切割(F2)"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   2700
      TabIndex        =   3
      Top             =   1560
      Width           =   3495
   End
   Begin VB.CommandButton ManulCmd 
      Caption         =   "移动控制(F1)"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   555
      Left            =   2700
      TabIndex        =   2
      Top             =   840
      Width           =   3495
   End
   Begin VB.CommandButton EndCmd 
      Caption         =   "退出(Alt+X)"
      Height          =   315
      Left            =   8220
      TabIndex        =   1
      Top             =   6720
      Width           =   1275
   End
   Begin VB.Label Label2 
      BackColor       =   &H00FFC0C0&
      Caption         =   "编辑程序"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   375
      Left            =   1500
      TabIndex        =   6
      Top             =   3180
      Width           =   1455
   End
   Begin VB.Label Label1 
      BackColor       =   &H00FFC0C0&
      Caption         =   "数控切割控制系统"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   24
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C00000&
      Height          =   615
      Left            =   2340
      TabIndex        =   0
      Top             =   120
      Width           =   4095
   End
End
Attribute VB_Name = "MainFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim updownlength  As Double
Dim updownPos As Double
Dim updownDirect As Integer

Private Sub AdjustCmd_Click()
    Unload Me
    AdjustFrm.Show vbModal
End Sub

Private Sub AdjustCmd_KeyDown(KeyCode As Integer, Shift As Integer)
    Call Process_Key(KeyCode, Shift)
End Sub

Private Sub Command1_Click()
    updownTimer.Enabled = True
    updownDirect = 0
'    WritePortDirect 3, 1
'    WritePortDirect 4, 1
'    WriteOneSignal 3, 1
'    WriteOneSignal 4, 1
'    updownDirect = 0
End Sub

Private Sub Command1_KeyDown(KeyCode As Integer, Shift As Integer)
    Call Process_Key(KeyCode, Shift)
End Sub

Private Sub Command2_Click()
    updownTimer.Enabled = True
    updownDirect = 0
'    WritePortDirect 3, 2
'    WritePortDirect 4, 2
'    WriteOneSignal 3, 1
'    WriteOneSignal 4, 1
End Sub

Private Sub Command2_KeyDown(KeyCode As Integer, Shift As Integer)
    Call Process_Key(KeyCode, Shift)
End Sub

Private Sub Command3_Click()
    updownTimer.Enabled = False
End Sub

Private Sub DirectCmd_Click()
    Unload Me
    DirectMultiFrm.Show vbModal
End Sub

Private Sub Form_Activate()
    'Me.Show vbModal
    G7 = 1
    G9 = 0
    M = 1
    X0 = 0
    Y0 = 0
    X1 = 0
    Y1 = 0
    X2 = 0
    Y2 = 0
    F = 0
    I = 0
    J = 0
    R = 0
    PrgFileLineNumber = 0
    perAngle = 3.14159 / 360 '缺省为大于0.5米的圆
    manulLRSpeed = 0
    
    Pi = 3.14159
    
    updownPos = 0
    
    Readupdownlength
    
    Dim A As Boolean
    A = ReadAdjustReal
    If (A = False) Then
        MsgBox "校准文件不存在，请先进行校准", vbInformation, "提示"
    Else
        LblAx.Caption = Ax & "毫米"
        LblAy.Caption = Ay & "毫米"
    End If
End Sub

Private Sub PrgControlCmd_Click()
    prmDlg.FileName = ""
    prmDlg.ShowOpen
    If (prmDlg.FileName <> "") Then
        ProgramFileName = prmDlg.FileName
        Unload Me
        PrgControlFrm.Show vbModal
    End If
End Sub

Private Sub PrgControlCmd_KeyDown(KeyCode As Integer, Shift As Integer)
    Call Process_Key(KeyCode, Shift)
End Sub

Private Sub DirectCmd_KeyDown(KeyCode As Integer, Shift As Integer)
    Call Process_Key(KeyCode, Shift)
End Sub

Private Sub AddPrgmCmd_Click()
    Shell "notepad.exe", vbMaximizedFocus
End Sub

Private Sub AddPrgmCmd_KeyDown(KeyCode As Integer, Shift As Integer)
    Call Process_Key(KeyCode, Shift)
End Sub

Private Sub EditPrgmCmd_Click()
    Dlg.FileName = ""
    Dlg.ShowOpen
    If (Dlg.FileName <> "") Then
        Shell "NotePad.exe " + Dlg.FileName, vbMaximizedFocus
    End If
End Sub

Private Sub EndCmd_Click()
    End
End Sub

Private Sub EndCmd_KeyDown(KeyCode As Integer, Shift As Integer)
    Call Process_Key(KeyCode, Shift)
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Call Process_Key(KeyCode, Shift)
End Sub

Private Sub Process_Key(KeyCode As Integer, Shift As Integer)
    If (Shift = 4) And (KeyCode = vbKeyX) Then 'Alt+x   结束程序
        End
    End If
    If (KeyCode = vbKeyF1) Then
        Call ManulCmd_Click
    End If
    If (KeyCode = vbKeyF2) Then
        Call DirectCmd_Click
    End If
    If (KeyCode = vbKeyF3) Then
        Call PrgControlCmd_Click
    End If
    If (KeyCode = vbKeyF4) Then
        Call AddPrgmCmd_Click
    End If
    If (KeyCode = vbKeyF5) Then
        Call EditPrgmCmd_Click
    End If
    If (KeyCode = vbKeyF6) Then
        Call AdjustCmd_Click
    End If
    If (KeyCode = vbKeyF7) Then
        Call Command1_Click
    End If
    If (KeyCode = vbKeyF8) Then
        Call Command2_Click
    End If
End Sub

Private Sub Form_Load()
    Me.Show vbModal

'    Dim A As Boolean
'    A = ReadAdjustReal
'    If (A = False) Then
'        MsgBox "校准文件不存在，请先进行校准", vbInformation, "提示"
'    End If
End Sub

Private Sub ManulCmd_Click()
    Unload Me
    ManulControlFrm.Show vbModal
End Sub

Private Sub ManulCmd_KeyDown(KeyCode As Integer, Shift As Integer)
    Call Process_Key(KeyCode, Shift)
End Sub

Private Sub Process_Program(FileName As String)
    Dim sOneLine As String
    
    Open FileName For Input As #1
        Do While Not EOF(1)
            Input #1, sOneLine
            
        Loop
    Close #1
End Sub

Private Sub Readupdownlength()
    Dim Mystr As String
    Close #1
    Open App.Path + "\设置文件\updownlength.txt" For Input As #1
        Input #1, Mystr
        updownlength = Mystr
    Close #1
End Sub

Private Sub updownTimer_Timer()
        
    If (updownDirect = 0) Then
        updownPos = updownPos + Az
        If (updownPos >= updownlength) Then
            updownTimer.Enabled = False
        End If
        WritePortDirect 3, 1
        WritePortDirect 4, 1
        WriteOneSignal 3, 1
        WriteOneSignal 4, 1
    Else
        updownPos = updownPos - Az
        If (updownPos <= -updownlength) Then
            updownTimer.Enabled = False
        End If
        WritePortDirect 3, 2
        WritePortDirect 4, 2
        WriteOneSignal 3, 1
        WriteOneSignal 4, 1
    End If
    
End Sub