frmpointedit.frm

本程序能实现机械臂在CATIA下的运动学仿真

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmPointEdit 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "多点运动位置编辑"
   ClientHeight    =   4320
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7620
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4320
   ScaleWidth      =   7620
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Tag             =   "1"
   Begin VB.CommandButton cmdInsertCurPos 
      Caption         =   "P"
      Height          =   285
      Left            =   1935
      TabIndex        =   7
      ToolTipText     =   "以当前关节坐标插入"
      Top             =   45
      Width           =   330
   End
   Begin VB.CommandButton cmdClear 
      Caption         =   "C"
      Height          =   285
      Left            =   1035
      TabIndex        =   6
      ToolTipText     =   "清空数据"
      Top             =   45
      Width           =   330
   End
   Begin MSComDlg.CommonDialog f1 
      Left            =   3600
      Top             =   315
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      CancelError     =   -1  'True
      Filter          =   "文本文件（*.txt）|*.txt|所有文件（*.*）|*.*"
   End
   Begin VB.CommandButton cmdLoad 
      Caption         =   "L"
      Height          =   285
      Left            =   6840
      TabIndex        =   5
      ToolTipText     =   "从文件中加载数据"
      Top             =   45
      Width           =   330
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "S"
      Height          =   285
      Left            =   6345
      TabIndex        =   4
      ToolTipText     =   "保存数据到文件"
      Top             =   45
      Width           =   330
   End
   Begin VB.CommandButton cmdRemove 
      Caption         =   "-"
      Height          =   285
      Left            =   495
      TabIndex        =   3
      ToolTipText     =   "移除当前行"
      Top             =   45
      Width           =   330
   End
   Begin VB.CommandButton cmdAdd 
      Caption         =   "+"
      Height          =   285
      Left            =   45
      TabIndex        =   2
      ToolTipText     =   "在当前行之前插入一行"
      Top             =   45
      Width           =   330
   End
   Begin VB.TextBox txtEdit 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      Height          =   240
      Left            =   5625
      MaxLength       =   10
      TabIndex        =   1
      Text            =   "Text1"
      Top             =   855
      Width           =   1500
   End
   Begin MSFlexGridLib.MSFlexGrid grdTest 
      Height          =   3975
      Left            =   0
      TabIndex        =   0
      Top             =   360
      Width           =   7620
      _ExtentX        =   13441
      _ExtentY        =   7011
      _Version        =   393216
      Cols            =   7
      AllowBigSelection=   0   'False
      Appearance      =   0
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
End
Attribute VB_Name = "frmPointEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdAdd_Click()
    
    grdTest.AddItem grdTest.rows, grdTest.Row
    MoveEditBox grdTest.Row, 1
    
    Dim i As Long
    For i = 1 To grdTest.rows - 1
        grdTest.TextMatrix(i, 0) = i
    Next

End Sub

Private Sub cmdClear_Click()

    initGrd

End Sub

Private Sub cmdInsertCurPos_Click()
    
    grdTest.AddItem grdTest.rows, grdTest.Row + 1
    MoveEditBox grdTest.Row + 1, 1
    
    Dim dVal(5)
    ArmMech.GetCommandValues dVal

    Dim i As Long
    For i = 1 To 6
        grdTest.TextMatrix(grdTest.Row, i) = Format(dVal(i - 1), "0.0")
    Next
''
'    For i = 1 To grdTest.rows - 1
'        grdTest.TextMatrix(i, 0) = i
'    Next

End Sub

Private Sub cmdLoad_Click()
    
    Dim n As Double
    Dim Q1 As Double
    Dim Q2 As Double
    Dim Q3 As Double
    Dim Q4 As Double
    Dim Q5 As Double
    Dim Q6 As Double
    
    Dim iCheck As Long
    
    On Error Resume Next
    
    f1.FileName = ""
    f1.ShowOpen
    If f1.FileName <> "" And Dir(f1.FileName) <> "" Then
            
        'open
        Dim fn As Long
        fn = FreeFile()
        Open f1.FileName For Input As #fn
            
            Input #fn, n, Q1, Q2, Q3, Q4, Q5, Q6
            
            iCheck = 1
            Do While Not EOF(fn)
            
                Input #fn, n, Q1, Q2, Q3, Q4, Q5, Q6
                
                If n = iCheck Then
                    
                    iPosCount = iCheck
                    ReDim Preserve iPosArr(1 To 6, 0 To iCheck)

                    iPosArr(1, iCheck) = Q1
                    iPosArr(2, iCheck) = Q2
                    iPosArr(3, iCheck) = Q3
                    iPosArr(4, iCheck) = Q4
                    iPosArr(5, iCheck) = Q5
                    iPosArr(6, iCheck) = Q6
                    
                    iCheck = iCheck + 1
                    
                End If
                
            Loop
        
        Close #fn
        
        LoadData
        
    End If
    
    On Error GoTo 0
    Exit Sub
    
ErrH:
    If Not Err.Number = 62 Then
        MsgBox Err.Number & vbCrLf & Err.Description, vbCritical
    End If
    
End Sub

Private Sub cmdRemove_Click()

    If grdTest.rows > 2 Then
    
        grdTest.RemoveItem grdTest.Row
        MoveEditBox grdTest.Row, 1
        
        Dim i As Long
        For i = 1 To grdTest.rows - 1
            grdTest.TextMatrix(i, 0) = i
        Next
    
    End If
    
End Sub



Private Sub cmdSave_Click()
    
    On Error GoTo ErrH
    
    f1.FileName = ""
    f1.ShowSave
    
    If f1.FileName <> "" Then
        
        If Dir(f1.FileName) <> "" Then
            
            Dim ans As Long
            ans = MsgBox("文件已经存在，要相覆盖吗？", vbYesNo + vbQuestion, "提醒")
            If ans = vbNo Then
                Exit Sub
            End If
        End If
        
        'save
        Dim fn As Long
        fn = FreeFile()
        Open f1.FileName For Output As #fn
        
            Print #fn, "位置        移动副          腰关节      ";
            Print #fn, "肩关节         肘关节       腕关节转       腕关节扭"
            
            Dim i As Long, j As Long
            For i = 1 To grdTest.rows - 1
                Print #fn, i,
                For j = 1 To 6
                    Print #fn, val(grdTest.TextMatrix(i, j)),
                Next
                Print #fn,
            Next
        
        Close #fn
        
    End If
    
    On Error GoTo 0
    Exit Sub
    
ErrH:
    If Not Err.Number = 32755 Then
        MsgBox Err.Number & vbCrLf & Err.Description, vbCritical
    End If
    
End Sub



Private Sub Form_Load()
    
    MakeMeOnTop Me.hwnd
    Me.Move Screen.Width - Me.Width - 1000, Screen.Height - Me.Height - 1500
    Me.Show
    
    initGrd
    
    grdTest.ColWidth(0) = 500
    
    LoadData
    
    MoveEditBox 1, 1

End Sub

Sub MoveEditBox(Optional ByVal i As Long = 0, Optional ByVal j As Long = 0)

    Dim selrow As Long
    Dim selcol As Long
    
    Dim rows As Long
    Dim cols As Long
    
    grdTest.SetFocus
    rows = grdTest.rows
    cols = grdTest.cols
        
    If i = 0 And j = 0 Then
        selrow = grdTest.Row
        selcol = grdTest.Col
    Else
        If i = 0 Then i = 1
        If j = 0 Then j = 1
        
        If i > rows - 1 Then i = rows - 1
                
        If i < rows - 1 And j > cols - 1 Then
                i = i + 1
                j = 1
        ElseIf j > cols - 1 Then
            grdTest.AddItem grdTest.rows
            i = i + 1
            j = 1
        End If
        
        selrow = i
        selcol = j
        grdTest.Row = i
        grdTest.Col = j
        
    End If
    
    Dim LeftOfText As Long, TopOfText As Long
    LeftOfText = grdTest.Left + grdTest.ColPos(selcol)
    TopOfText = grdTest.Top + grdTest.RowPos(selrow)
    
    txtEdit.Move LeftOfText, TopOfText, grdTest.ColWidth(selcol) ', grdtest.RowHeight(selrow) - 45
    txtEdit.SetFocus

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

    Dim i As Long, j As Long

    ReDim iPosArr(1 To 6, 0 To grdTest.rows - 1)
    iPosCount = grdTest.rows - 1

    For i = 1 To grdTest.rows - 1
        For j = 1 To 6
            iPosArr(j, i) = val(grdTest.TextMatrix(i, j))
        Next
    Next

    iCurPos = 0

    frmMain.Show

End Sub

Sub LoadData()
    
    Dim i As Long, j As Long
    
    initGrd
    
    For i = 2 To iPosCount
        grdTest.AddItem i
    Next
    grdTest.TextMatrix(1, 0) = 1
    
    For i = 1 To grdTest.rows - 1
        For j = 1 To 6
            grdTest.TextMatrix(i, j) = iPosArr(j, i)
        Next
    Next
    MoveEditBox 1, 1

End Sub


Private Sub grdtest_EnterCell()

    MoveEditBox
    
End Sub

Private Sub txtEdit_Change()

        grdTest.TextMatrix(grdTest.Row, grdTest.Col) = val(txtEdit.Text)

End Sub

Private Sub txtEdit_GotFocus()

    txtEdit.Text = grdTest.TextMatrix(grdTest.Row, grdTest.Col)
    
    txtEdit.Visible = True
    txtEdit.SelStart = 0
    txtEdit.SelLength = Len(txtEdit.Text)

End Sub

Private Sub txtEdit_KeyDown(KeyCode As Integer, Shift As Integer)
    
    Select Case KeyCode
    Case 38         ' 向上
        grdTest.TextMatrix(grdTest.Row, grdTest.Col) = val(txtEdit.Text)
        MoveEditBox grdTest.Row - 1, grdTest.Col
    Case 40         ' 向下
        grdTest.TextMatrix(grdTest.Row, grdTest.Col) = val(txtEdit.Text)
        MoveEditBox grdTest.Row + 1, grdTest.Col
    Case 13         ' 回车键
        grdTest.TextMatrix(grdTest.Row, grdTest.Col) = val(txtEdit.Text)
        MoveEditBox grdTest.Row, grdTest.Col + 1
    End Select

End Sub


Sub initGrd()
    
    Dim i As Long
    
    grdTest.Clear
    For i = grdTest.rows To 3 Step -1
        grdTest.RemoveItem i
    Next
    txtEdit.Text = ""

    grdTest.TextMatrix(0, 0) = "位置"
    grdTest.TextMatrix(1, 1) = 0
    grdTest.TextMatrix(0, 1) = "移动副"
    grdTest.TextMatrix(0, 2) = "腰关节"
    grdTest.TextMatrix(0, 3) = "肩关节"
    grdTest.TextMatrix(0, 4) = "肘关节"
    grdTest.TextMatrix(0, 5) = "腕关节转"
    grdTest.TextMatrix(0, 6) = "腕关节扭"
    
    grdTest.ColWidth(0) = 500

    MoveEditBox 1, 1
    
End Sub