frmmain.frm

老外用VB写的CNC仿真程序源码

mnuToolsPlaySound.Checked = Not mnuToolsPlaySound.Checked
End Sub

Private Sub mnuToolsReformatText_Click()
    ReformatText TextEditor
End Sub

Private Sub mnuView3DWindow_Click()
    Load frm3D
    frm3D.Show
End Sub

Private Sub mnuViewDebugWindow_Click()
    mnuViewDebugWindow.Checked = Not mnuViewDebugWindow.Checked
    DebugWindow.Visible = mnuViewDebugWindow.Checked
    If TextEditor.Visible = True And DebugWindow.Visible = True Then
        TextEditor.Visible = False
        mnuViewTextEditor.Checked = False
    End If
    Call AdjustFormControls
    Call SaveSetting("CNC", "ViewOptions", "DebugWindow", mnuViewDebugWindow.Checked)
    Call SaveSetting("CNC", "ViewOptions", "TextEditor", mnuViewTextEditor.Checked)
    If TextChanged Then CopyCodeToDebugWindow
    
    DoEvents
End Sub

Private Sub mnuViewStatusBar_Click()
    mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
    StatusBar.Visible = mnuViewStatusBar.Checked
    Call AdjustFormControls
    Call SaveSetting("CNC", "ViewOptions", "StatusBar", mnuViewStatusBar.Checked)
End Sub

Private Sub mnuViewTextEditor_Click()
    mnuViewTextEditor.Checked = Not mnuViewTextEditor.Checked
    TextEditor.Visible = mnuViewTextEditor.Checked
    If TextEditor.Visible = True And DebugWindow.Visible = True Then
        DebugWindow.Visible = False
        mnuViewDebugWindow.Checked = False
    End If
    Call AdjustFormControls
    Call SaveSetting("CNC", "ViewOptions", "TextEditor", mnuViewTextEditor.Checked)
    Call SaveSetting("CNC", "ViewOptions", "DebugWindow", mnuViewDebugWindow.Checked)
    If TextEditor.Visible Then
        TextBuffer.Text = TextEditor.Text
        Coloring
    End If
End Sub

Private Sub mnuViewToolBar_Click()
    mnuViewToolBar.Checked = Not mnuViewToolBar.Checked
    Toolbar.Visible = mnuViewToolBar.Checked
    Call AdjustFormControls
    Call SaveSetting("CNC", "ViewOptions", "Toolbar", mnuViewToolBar.Checked)
End Sub

Private Sub picSim_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'frmMain.StatusBar.Panels("MousePosition").Text = "X: " & X & ", Y: " & Y
End Sub

Private Sub picSim_Paint()
    Call DrawPicture
End Sub

Private Sub TextEditor_Change()
    TextChanged = True
    If TextEditor.Text = "" Then
        Call EnableDisableButtons("Save,Print,Step,Start,Pause,Stop", False)
        Exit Sub
    End If

    If Toolbar.Buttons.Item("Save").Enabled = False Then _
        Call EnableDisableButtons("Save,Print,Start,Step", True)
End Sub

Private Sub TextEditor_KeyPress(KeyAscii As Integer)
    'To Capitalize each character
    If KeyAscii > 96 And KeyAscii < 123 Then KeyAscii = KeyAscii - 32
End Sub

Private Sub TextEditor_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 And TextEditor.SelLength <> 0 And GeneralSettings.AutoComplete Then   'autocomplete [BILLET
        SendKeys "{RIGHT}"
        SendKeys " "
        KeyCode = 0
        Exit Sub
    End If
    
    If Shift = 0 Or Shift = 1 Then 'if control key is pressed then skip this
        If KeyCode >= 65 And KeyCode <= 90 Or KeyCode = 219 Or KeyCode = 32 Or KeyCode = 39 Then
            TextEditor.SelColor = Editor.CharacterColor
        ElseIf ((KeyCode >= 96 And KeyCode <= 105) Or (KeyCode >= 48 And KeyCode <= 57)) And Shift = 0 Then
            TextEditor.SelColor = Editor.IntegerColor
        End If
    End If
End Sub

Private Sub TextEditor_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 219 And GeneralSettings.AutoComplete Then    'autocomplete [BILLET
        Dim i%
        i = TextEditor.SelStart
        SendKeys ("BILLET")
        DoEvents
        TextEditor.SelStart = i
        TextEditor.SelLength = 6
    End If

End Sub


Private Sub Timer1_Timer()
    Beep Frequency, 1
End Sub

Private Sub Toolbar_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 And Toolbar.Buttons("New").Enabled Then
        PopupMenu mnuToolBar
    End If
End Sub

Private Sub Toolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "Step"
            Call mnuRunStepInto_Click
        Case "Start"
            Call mnuRunStart_Click
        Case "Pause"
            Call mnuRunPause_Click
        Case "Stop"
            Call mnuRunStop_Click
        Case "New"
            Call mnuFileNew_Click
        Case "Open"
            Call mnuFileOpen_Click
        Case "Save"
            Call mnuFileSave_Click
        Case "Print"
            Call mnuFilePrint_Click
        Case "Options"
            Call mnuToolsOptions_Click
    End Select
End Sub

'To enable or disable toolbar buttons and menuitems eg. EnableDisableButtons "save,print", true
Private Sub EnableDisableButtons(ByVal ButtonsList As String, ByVal flag As Boolean)
    Dim i%
    Dim TempArray() As String
    TempArray = Split(ButtonsList, ",")
    For i = 0 To UBound(TempArray)
        Toolbar.Buttons.Item(TempArray(i)).Enabled = flag 'yeh toolbar ke saare buttons ko On/off kar deta hai
        Select Case TempArray(i)
            Case "Save"
                mnuFileSave.Enabled = flag
            Case "Print"
                mnuFilePrint.Enabled = flag
            Case "Start"
                mnuRunStart.Enabled = flag
            Case "Pause"
                mnuRunPause.Enabled = flag
            Case "Stop"
                mnuRunStop.Enabled = flag
            Case "Step"
                mnuRunStepInto.Enabled = flag
        End Select
    Next i
End Sub

'load settings from registry
Private Sub LoadProgramSettings()
    'texteditor
    TextEditor.BackColor = Editor.BackgroundColor
    TextEditor.Font = Editor.FontName
    TextEditor.SelFontSize = Editor.FontSize
    TextEditor.SelBold = Editor.Bold
    
    'DebugWindow
    Call SetDebugWindow
    
    'Simulation window
    picSim.BackColor = SimWindow.BackColor
    
    mnuToolBarShowLabels.Checked = Not CBool(GetSetting("CNC", "Toolbar", "ShowLabels", True))   'kyunki click isko reverse kar dega
    Call mnuToolBarShowLabels_Click 'update labels
    
    'view options
    mnuViewToolBar.Checked = GetSetting("CNC", "ViewOptions", "Toolbar", True)
    mnuViewStatusBar.Checked = GetSetting("CNC", "ViewOptions", "StatusBar", True)
    mnuViewTextEditor.Checked = GetSetting("CNC", "ViewOptions", "TextEditor", True)
    mnuViewDebugWindow.Checked = GetSetting("CNC", "ViewOptions", "DebugWindow", False)
        
    StatusBar.Visible = mnuViewStatusBar.Checked
    TextEditor.Visible = mnuViewTextEditor.Checked
    Toolbar.Visible = mnuViewToolBar.Checked
    DebugWindow.Visible = mnuViewDebugWindow.Checked
End Sub

'get recent file list from memory and add to the menu
Private Sub GetRecentFilesList()
    If GetSetting("CNC", "RecentFilePaths", "0") = "" Then  'no recent files found
        mnuFileRecentFiles(0).Caption = "Recent Files"
        mnuFileRecentFiles(0).Enabled = False
        Exit Sub
    Else
        mnuFileRecentFiles(0).Caption = "&1   " & GetFileName(GetSetting("CNC", "RecentFilePaths", "0"))
        mnuFileRecentFiles(0).Enabled = True
    End If
    
    'add recent files
    Dim i%
    Dim n As Menu
    
    'Unload previous menu
    For Each n In mnuFileRecentFiles
        If n.Index > 0 Then Unload n 'to avoid unloading of 0 index
    Next
    
    For i = 1 To 3
        If GetSetting("CNC", "RecentFilePaths", i) = "" Then Exit Sub   'no more files
        Load mnuFileRecentFiles(i) 'add files
        mnuFileRecentFiles(i).Caption = "&" & (i + 1) & "   " & GetFileName(GetSetting("CNC", "RecentFilePaths", i))
    Next i
End Sub

Private Sub mnuFileRecentFiles_Click(Index As Integer)
On Error GoTo Err
    If Toolbar.Buttons.Item("Save").Enabled = True Then
        Dim ans As String
        ans = MsgBox("Save changes to " & StatusBar.Panels("FileName").Text & "?", vbQuestion + vbYesNoCancel, "Save Changes?")
        If ans = vbCancel Then Exit Sub
        If ans = vbYes Then
            Call mnuFileSave_Click
            If Toolbar.Buttons.Item("Save").Enabled = True Then Exit Sub    'save as main cancel ho gaya
        End If
    End If
    TextBuffer.LoadFile GetSetting("CNC", "RecentFilePaths", CStr(Index)), vbCFText
    Call Coloring
    StatusBar.Panels("FileName").Text = GetFileName(TextBuffer.fileName)
    EnableDisableButtons "Start,Print,Step", True
    EnableDisableButtons "Save", False
    Call ChangeRecentFilesList(mnuFileRecentFiles(Index).Caption, Index)
    Call CopyCodeToDebugWindow
    TextChanged = False

Err:
    If Err.Number <> 0 Then _
        MsgBox Err.Description, vbCritical
End Sub

Private Sub ReformatText(ByRef TextBox As RichTextBox)
    Dim TempArray() As String
    Dim j%, i%, s$, str$, newStr$, retText$
    TempArray = Split(TextBox.Text, vbCrLf)
    For j = 0 To UBound(TempArray)
        str = Trim$(TempArray(j))
        
        's gets the comment
        If InStr(str, "[") Then
            s = Mid$(str, InStr(str, "["), Len(str) - InStr(str, "[") + 1)
        Else
            s = ""
        End If
        
        str = Left$(str, Len(str) - Len(s))
        str = Replace$(str, " ", "")
        str = Replace$(str, vbTab, "")
        str = UCase$(str)
        For i = 1 To Len(str)
            Select Case Mid$(str, i, 1)
                Case "A" To "Z"   'insert space
                    newStr = newStr & " " & Mid$(str, i, 1)
                Case Else
                    newStr = newStr & Mid$(str, i, 1)
            End Select
        Next i
        newStr = Trim$(newStr)
        TempArray(j) = Trim$(newStr & " " & s)
        newStr = ""
    Next j
    For i = 0 To UBound(TempArray)
        If Trim$(TempArray(i)) = "" Then GoTo Nextline
        retText = retText & TempArray(i)
        If i <> UBound(TempArray) Then retText = retText & vbCrLf
Nextline:
    Next i
    TextBuffer.Text = retText
    SaveButtonLastState = Toolbar.Buttons("Save").Enabled
    Call Coloring
    Toolbar.Buttons("Save").Enabled = SaveButtonLastState
End Sub

'Following function is used to check errors in the referred textbox
Private Function FindError(ByRef TextBox As RichTextBox) As Boolean
    Dim LineArray, BlockArray As Variant 'Arrays to strore Lines and blocks
    Dim StartPoint%, BlockLength%, ModifiedLength% 'used for highlighting
    Dim TotalLength As Long 'used to calculate selstart point
    Dim i%, j%, Code$ 'temp variables
    Code = TextBox.Text 'assign textbox's text to variable
    LineArray = Split(Code, vbCrLf) 'Make a line array
    For i = 0 To UBound(LineArray)
        BlockArray = Split(Trim$(LineArray(i))) 'make a block array
        StartPoint = 0
        BlockLength = 0
        For j = 0 To UBound(BlockArray)
            If BlockArray(j) = "" Then GoTo NextBlock
            If UCase$(CStr(Left(BlockArray(j), 1))) = "[" Then Exit For 'if this block is a comment then skip all next blocks
            
            'error handling
            
            'check for invalid characters
            Dim k As Integer
            For k = 1 To Len(BlockArray(j))
                If InStr("FGIKMNPQRSTUWXZ0123456789.-+", UCase$(Mid$(BlockArray(j), k, 1))) = 0 Then
                    If TextEditor.Visible = False Then mnuViewTextEditor_Click
                    'highlight
                    TextBox.SelStart = StartPoint + TotalLength + k - 1
                    TextBox.SelLength = 1
                    
                    
                    MsgBox "An invalid character '" & TextBox.SelText & "' was found.", vbInformation + vbOKOnly, "Syntax Error!"
                    FindError = True
                    Exit Function
                End If
            Next k
            
            'first char should be valid code (G,M,X etc.). The following chars should be related to the first char.
            If Not ((UCase$(CStr(Left$(BlockArray(j), 1))) >= "A" And UCase$(CStr(Left$(BlockArray(j), 1))) <= "Z")) Then
                If TextEditor.Visible = False Then mnuViewTextEditor_Click
                'highlight
                TextBox.SelStart = StartPoint + TotalLength
                TextBox.SelLength = 1
                TextBox.SelText = " " & TextBox.SelText
                TextBox.SelStart = StartPoint + TotalLength '+ ModifiedLength
                TextBox.SelLength = 1
                
                
                MsgBox "Missing Character at this position.", vbInformation + vbOKOnly, "Syntax Error!"
                FindError = True
                Exit Function
            End If
            
            'right waala number hona chahiye
            If Not IsNumeric(Right$(BlockArray(j), Len(BlockArray(j)) - 1)) Then
                If TextEditor.Visible = False Then mnuViewTextEditor_Click
                'highlight
                TextBox.SelStart = StartPoint + TotalLength + 1
                TextBox.SelLength = Len(BlockArray(j)) - 1
                
                
                MsgBox "This is not a valid numeric value", vbInformation + vbOKOnly, "Syntax Error!"
                FindError = True
                Exit Function
            End If
            
            'check for valid g, m codes etc.
            Select Case UCase$(CStr(Left$(BlockArray(j), 1)))
            Case "G"
                Select Case CInt(Right$(BlockArray(j), Len(BlockArray(j)) - 1))
                Case 0, 1, 2, 3, 4, 21, 28, 70, 71, 72, 73, 90, 94, 97, 98
                    'do nothing
                Case Else
                    If TextEditor.Visible = False Then mnuViewTextEditor_Click
                    TextBox.SelStart = StartPoint + TotalLength
                    TextBox.SelLength = Len(BlockArray(j))
                    
                    
                    MsgBox TextBox.SelText & " is not a valid G Code", vbInformation + vbOKOnly, "Syntax Error!"
                    FindError = True
                    Exit Function
                End Select
            End Select
NextBlock:
            StartPoint = StartPoint + Len(BlockArray(j)) + 1
            ModifiedLength = 0
        Next j
        TotalLength = TotalLength + Len(LineArray(i)) + 2
    Next i
    FindError = False
End Function

Private Sub txtDebug_KeyUp(KeyCode As Integer, Shift As Integer)
    Dim i%
    If KeyCode = 13 Then
        DebugWindow.TextMatrix(DebugCurrentLine, 2) = txtDebug.Text
        TextEditor.Text = ""
        For i = 0 To DebugWindow.Rows - 2
            TextEditor.Text = TextEditor.Text & DebugWindow.TextMatrix(i, 2) & vbCrLf
        Next i
        TextEditor.Text = TextEditor.Text & DebugWindow.TextMatrix(i, 2)
        txtDebug.Visible = False
        TextChanged = False
    End If
    If KeyCode = 27 Then
        txtDebug.Visible = False
    End If
    
End Sub