控制程序.frm

用vb编写的工程控制程序

         _ExtentX        =   1005
         _ExtentY        =   1005
         BackColor       =   -2147483643
         ImageWidth      =   32
         ImageHeight     =   32
         MaskColor       =   12632256
         _Version        =   393216
         BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
            NumListImages   =   2
            BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "控制程序.frx":0918
               Key             =   ""
            EndProperty
            BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "控制程序.frx":0C32
               Key             =   ""
            EndProperty
         EndProperty
      End
   End
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   345
      Left            =   0
      TabIndex        =   4
      Top             =   7635
      Width           =   9735
      _ExtentX        =   17171
      _ExtentY        =   609
      SimpleText      =   "就绪"
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   4
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   3528
            MinWidth        =   3528
            Text            =   "就绪"
            TextSave        =   "就绪"
            Key             =   "state"
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Alignment       =   1
            Object.Width           =   8819
            MinWidth        =   8819
            Text            =   "湖南大学机汽院"
            TextSave        =   "湖南大学机汽院"
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   5
            Alignment       =   1
            TextSave        =   "16:41"
         EndProperty
         BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   6
            Alignment       =   1
            TextSave        =   "2005-9-18"
         EndProperty
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Label Label4 
      Caption         =   "时间--位移关系图 "
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   3480
      TabIndex        =   1
      Top             =   960
      Width           =   2415
   End
   Begin VB.Menu shezhi 
      Caption         =   "设置(&S)"
      Index           =   1
      Begin VB.Menu canshu 
         Caption         =   "参数"
         Index           =   2
         Shortcut        =   {F2}
      End
   End
   Begin VB.Menu sys 
      Caption         =   "系统(&x)"
      Begin VB.Menu exit 
         Caption         =   "退出"
         Shortcut        =   ^Q
      End
   End
   Begin VB.Menu hlep 
      Caption         =   "帮助(&h)"
      Begin VB.Menu about 
         Caption         =   "关于"
         Shortcut        =   ^A
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Tempname As String
Dim i As Integer
Public mode As Integer
'串口初始化模块
 Sub InitCOM()
  On Local Error GoTo err1
  If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
   MSComm1.CommPort = 1 '或其他口
   MSComm1.EOFEnable = True
   '由于和单片机通讯，只使用3根信号线，以下设置非常重要
   MSComm1.DTREnable = False
   MSComm1.Handshaking = comNone
   MSComm1.InBufferSize = 512
   '设置通讯数据大小为6个字节长
   MSComm1.InputLen = 0
   '设置通讯每6个字节长中断一次
   MSComm1.RThreshold = 0
   MSComm1.RTSEnable = False
   MSComm1.SThreshold = 0
   ' 9600 波特，无奇偶校验，8 位数据，一个停止位。
   MSComm1.Settings = "9600,N,8,1"
   '设定 InputMode 读取二进制数据
    MSComm1.InputMode = comInputModeBinary
   ' 当输入占用时，
   ' 告诉控件读入整个缓冲区。
   'MSComm1.InputLen = 0
   ' 打开端口。
   MSComm1.PortOpen = True
   COMPortOK = True
   MSComm1.OutBufferCount = 0              '清空发送缓冲区
    MSComm1.InBufferCount = 0               '滑空接收缓冲区

    Exit Sub
err1:
    If err.Source = "MSComm" Then
        'COMPortOK 为指示串口是否打开的全局变量
        COMPortOK = False
        MsgBox "串口不存在或连线未接", vbOKOnly + vbInformation
    End If

End Sub


Private Sub Form_Load()

    Call InitCOM   '串口初始化
    'On Local Error GoTo err
    'NTportio = AC_OpenDriver()
    'cardnumber = AC_6011_INIT(NTportio, cardid(0))
    'If cardnumber = 0 Then
    'MsgBox "没有发现AC板"
     'Command1.Enabled = False
     'End If
    acpci.Kp = 1.6
    acpci.Ti = 1.5
    acpci.Td = 0
    acpci.T = 0.05
    acpci.Sr = 200
    acpci.A = 0.8
    acpci.filepath = App.Path & "\"
    ' -----------------选模式二
      mode = 2
      CMD = &H22 '控制命令 输出
      D1 = mode
      D2 = 0
     Call send_data(CMD, D1, D2)
     '-------------------------
     Picture1_Paint
     cmdstop.Enabled = False
     cmdsave.Enabled = False
     Timer1.Enabled = False
     Exit Sub
err:
    MsgBox err.Description, 48, "错误提示！"
    Unload Me
    
End Sub

Private Sub exit_Click()
 Unload Me
 
End Sub
Private Sub cmdcls_Click()
    Picture1.Cls  '清屏
    Picture1_Paint
End Sub

Private Sub cmdrun_Click()
    '-------------初始化 ----------
    x1 = 0
    y1 = 0
    
    If acpci.Ti <> 0 Then
        acpci.CT = 1 / Ti
    Else
        acpci.CT = 0
    End If
        
    acpci.e(1) = 0
    acpci.e(2) = 0
    acpci.e(3) = 0
    acpci.e(4) = 0
    acpci.e(5) = 0
    acpci.i = 0
    Tempname = Format(Timer, "hh-nn-ss")
    'MkDir acpci.filepath & Tempname
    acpci.FileName = acpci.filepath & Tempname & "\" & Tempname & ".txt"
    'Timrun.Enabled = True
    cmdsave.Enabled = False
    cmdrun.Enabled = False
    cmdstop.Enabled = True
    imgConnected.Visible = False
    Timer1.Enabled = True
     Form1.StatusBar1.Panels(1).Text = "正在运行..."
    '---------
    GO = True
    Main
End Sub

Private Sub cmdsave_Click()
    On Error Resume Next
  
   openlog.DialogTitle = "保存图形"
   openlog.Filter = "图形 (*.bmp)|*.bmp|所有文件 (*.*)|*.*"
    openlog.CancelError = True
    openlog.FileName = Tempname & ".bmp"
      openlog.InitDir = acpci.filepath & Tempname
      openlog.ShowSave
       If err = cdlCancel Then
       cmdsave.Enabled = True
       Else
       cmdsave.Enabled = False
    SavePicture Picture1.Image, openlog.FileName
    End If
End Sub

Private Sub cmdstop_Click()
    GO = False
    'Timrun.Enabled = False
    cmdrun.Enabled = True
    cmdstop.Enabled = False
    StatusBar1.Panels(1).Text = "结束/就绪"
    cmdsave.Enabled = True
    imgConnected.Visible = True
    Timer1.Enabled = False
End Sub

Private Sub Picture1_Paint()
Dim xt As Integer
    Dim yt As Integer
    Dim st As String
    
    Picture1.Cls
    Picture1.DrawWidth = 2
    Picture1.Scale (-300, 3200)-(9200, -300)
    Picture1.Line (0, 0)-(9000, 3000), RGB(0, 0, 0), B
    
    Picture1.CurrentX = -50
    Picture1.CurrentY = -50
    Picture1.Print "0"
    
    For xt = 600 To 9000 Step 600
        Picture1.CurrentX = xt - 50
        Picture1.CurrentY = -50
        Picture1.Print CStr(xt / 600)
    Next xt
    
    For yt = 500 To 3000 Step 500
        Picture1.CurrentX = -300
        Picture1.CurrentY = yt + 100
        Picture1.Print CStr(yt / 10)
    Next yt
    
    Picture1.DrawWidth = 1
     For xt = 600 To 9000 Step 600
       Picture1.Line (xt, 3000)-(xt, 0)
    Next xt
    
     For yt = 500 To 3000 Step 500
        Picture1.Line (0, yt)-(9000, yt)
    Next yt
    
End Sub



Private Sub Timer1_Timer()
 If imgNotConnected.Visible = False Then
    imgNotConnected.Visible = True
 Else
    imgNotConnected.Visible = False
 End If
 
End Sub



Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
  Select Case Button.Key
        Case "shezhi"
          Form2.Show vbModal
        Case "exit"
           Unload Me
        
    End Select
End Sub


Private Sub about_Click()
    frmAbout.Show
End Sub

Private Sub canshu_Click(Index As Integer)
    Form2.Show
End Sub

Private Sub Form_Unload(Cancel As Integer)
   'If MsgBox("你想退出吗？", vbYesNo, "退出") = vbNo Then
   'Cancel = True
   'End If
   If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    AC_CloseDriver (NTportio)
End Sub