frmmain.frm

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

         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin ComctlLib.ImageList imgListDebugWindow 
      Left            =   480
      Top             =   3720
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   19
      ImageHeight     =   18
      MaskColor       =   12632256
      _Version        =   327682
      BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} 
         NumListImages   =   3
         BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frmMain.frx":103F6
            Key             =   "Both"
         EndProperty
         BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frmMain.frx":10880
            Key             =   "Break"
         EndProperty
         BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frmMain.frx":10D0A
            Key             =   "Step"
         EndProperty
      EndProperty
   End
   Begin VB.Menu mnuFile 
      Caption         =   "&File"
      Begin VB.Menu mnuFileNew 
         Caption         =   "&New"
         Shortcut        =   ^N
      End
      Begin VB.Menu mnuFileOpen 
         Caption         =   "&Open..."
         Shortcut        =   ^O
      End
      Begin VB.Menu mnuFileSave 
         Caption         =   "&Save"
         Shortcut        =   ^S
      End
      Begin VB.Menu mnuFileSaveAS 
         Caption         =   "Save &As..."
      End
      Begin VB.Menu mnuFileLine1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFilePrint 
         Caption         =   "&Print..."
         Shortcut        =   ^P
      End
      Begin VB.Menu mnuFileLine2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileRecentFiles 
         Caption         =   "Recent Files"
         Index           =   0
      End
      Begin VB.Menu mnuFileLine3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit 
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuView 
      Caption         =   "&View"
      Begin VB.Menu mnuViewStatusBar 
         Caption         =   "&Status Bar"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuViewToolBar 
         Caption         =   "&Tool Bar"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuViewTextEditor 
         Caption         =   "&Text Editor"
         Checked         =   -1  'True
         Shortcut        =   ^T
      End
      Begin VB.Menu mnuViewDebugWindow 
         Caption         =   "&Debug Window"
         Shortcut        =   ^D
      End
      Begin VB.Menu mnuViewLine1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuView3DWindow 
         Caption         =   "&3D Window"
         Shortcut        =   {F12}
      End
   End
   Begin VB.Menu mnuRun 
      Caption         =   "&Run"
      Begin VB.Menu mnuRunStart 
         Caption         =   "&Start"
         Shortcut        =   {F5}
      End
      Begin VB.Menu mnuRunPause 
         Caption         =   "&Pause"
         Shortcut        =   {F6}
      End
      Begin VB.Menu mnuRunStop 
         Caption         =   "S&top"
         Shortcut        =   {F7}
      End
      Begin VB.Menu mnuRunLine1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuRunStepInto 
         Caption         =   "St&ep"
         Shortcut        =   {F8}
      End
      Begin VB.Menu mnuRunRunToBreakpoint 
         Caption         =   "&Run To Breakpoint"
         Shortcut        =   ^{F5}
      End
   End
   Begin VB.Menu mnuTools 
      Caption         =   "&Tools"
      Begin VB.Menu mnuToolLibrary 
         Caption         =   "&Tool Library..."
      End
      Begin VB.Menu mnuToolsPlaySound 
         Caption         =   "&Play Sound"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuToolsReformatText 
         Caption         =   "&Reformat Text"
      End
      Begin VB.Menu mnuToolsLine1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuToolsOptions 
         Caption         =   "Options..."
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "&Help"
      Begin VB.Menu mnuHelpContents 
         Caption         =   "&Contents..."
         Shortcut        =   ^{F1}
      End
      Begin VB.Menu mnuHelpLine1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "&About CNC Simulator..."
      End
   End
   Begin VB.Menu mnuToolBar 
      Caption         =   "ToolBar"
      Visible         =   0   'False
      Begin VB.Menu mnuToolBarShowLabels 
         Caption         =   "&Show Labels"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuToolBarLine1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuToolBarCustomize 
         Caption         =   "&Customize..."
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private SaveButtonLastState As Boolean
Private FormPainted As Boolean
Private TextChanged As Boolean
Private DebugCurrentLine As Integer

Private Sub DebugWindow_DblClick()
    DebugCurrentLine = DebugWindow.MouseRow
    DebugWindow.Col = 2
    DebugWindow.Row = DebugWindow.MouseRow
    txtDebug.Text = DebugWindow.TextMatrix(DebugWindow.MouseRow, 2)
        
    txtDebug.Font = Debuger.FontName
    txtDebug.FontSize = Debuger.FontSize
    
    txtDebug.Height = Debuger.RowHeight / 15
    txtDebug.Width = DebugWindow.Width - DebugWindow.CellLeft / 15 - 4
    txtDebug.Top = DebugWindow.CellTop / 15 + DebugWindow.Top
    txtDebug.Left = DebugWindow.CellLeft / 15
    
    txtDebug.Visible = True
    txtDebug.SetFocus
    txtDebug.SelStart = Len(txtDebug)
    

End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)

If KeyCode = 113 Then DrawPicture
End Sub

Private Sub Form_Load()

    Call InitializeTypeVariables
    Call LoadProgramSettings
    Call GetRecentFilesList
    Call EnableDisableButtons("Save,Print,Step,Start,Pause,Stop", False)
    StatusBar.Panels("FileName").Text = "Untitled"
    com.InitDir = App.path
    If GeneralSettings.SplashScreen Then _
        frmSplash.Show 1
    If GeneralSettings.OpenLastFile And mnuFileRecentFiles(0).Enabled Then _
        mnuFileRecentFiles_Click (0)
End Sub

Private Sub Form_Resize() 'Not OK
    If Me.WindowState <> vbMinimized Then
        Call AdjustFormControls
    End If
    Me.WindowState = vbMaximized 'Error
    FormPainted = False
End Sub

Private Sub AdjustFormControls() 'OK
    TextEditor.Top = IIf(Toolbar.Visible, Toolbar.Height, 0)
    TextEditor.Height = IIf(StatusBar.Visible, Me.ScaleHeight - TextEditor.Top - StatusBar.Height, Me.ScaleHeight - TextEditor.Top)
    TextEditor.Left = 0
    TextEditor.Width = Me.ScaleWidth * 0.23
    
    DebugWindow.Move 0, TextEditor.Top, TextEditor.Width, TextEditor.Height
    
    picSim.Top = TextEditor.Top
    picSim.Height = TextEditor.Height
    picSim.Left = IIf(TextEditor.Visible Or DebugWindow.Visible, TextEditor.Width, 0)
    picSim.Width = IIf(TextEditor.Visible Or DebugWindow.Visible, Me.ScaleWidth - TextEditor.Width, Me.ScaleWidth)
    
    PicWidth = picSim.ScaleWidth
    PicHeight = picSim.ScaleHeight
    Call SetMainMemory
End Sub

Private Sub mnuHelpAbout_Click()
    frmSplash.Show 1
End Sub

Private Sub mnuHelpContents_Click()
    Shell "hh " & App.path & "\help.chm", vbNormalFocus
End Sub

Public Sub mnuRunPause_Click()
    EnableDisableButtons "Start", True
    EnableDisableButtons "Pause", False
    TextEditor.Locked = False
    PlayWav App.path & "\sound\stop.wav"
End Sub

Private Sub mnuRunRunToBreakpoint_Click()
    RunToCursor = True
    Call mnuRunStart_Click
End Sub

Private Sub mnuRunStart_Click()
    If Toolbar.Buttons.Item("Pause").Enabled = False And _
        Toolbar.Buttons.Item("Stop").Enabled = True Then
        
        Toolbar.Buttons.Item("Start").Enabled = False
        Toolbar.Buttons.Item("Pause").Enabled = True
        Exit Sub
    End If
    
    Call ReformatText(TextEditor)
    
    If FindError(TextEditor) Then Exit Sub
    
    SaveButtonLastState = Toolbar.Buttons.Item("Save").Enabled
    Call EnableDisableButtons("New,Open,Save,Print,Start,Step,Options", False)
    mnuFile.Enabled = False
    mnuView.Enabled = False
    mnuTools.Enabled = False
    mnuHelp.Enabled = False
    TextEditor.Locked = True
        
    If Toolbar.Buttons.Item("Stop").Enabled = False Then _
        Call SetToolMemory(App.path & "\tools\tool.bmp", 67, 101)
    
    Call EnableDisableButtons("Pause,Stop", True)
    If mnuViewTextEditor.Checked = True Then
        mnuViewDebugWindow_Click
    End If
    
    PrvX = -500
    PrvY = -500
    Call ClearMainMemory
    
    StopSimulation = False
    
    DebugWindow.TopRow = 0
    Call StartSimulation
    Call Effects
    Call mnuRunStop_Click
End Sub

Public Sub RemoveHighLighting(LineNum As Integer)
    If LineNum = -1 Then Exit Sub
    With DebugWindow
        .Row = LineNum
        If .TextMatrix(LineNum, 3) = "BP" Then
            .Col = 1
            Set .CellPicture = imgListDebugWindow.ListImages("Break").Picture
            .CellPictureAlignment = flexAlignCenterCenter
            .Col = 2
            .CellBackColor = Debuger.BreakPointColor
            .CellForeColor = Debuger.BreakPointTextColor
            .CellFontBold = True
        ElseIf .TextMatrix(LineNum, 3) = "" Then
            .Col = 1
            Set .CellPicture = LoadPicture("")
            .Col = 2
            .CellBackColor = Debuger.NormalBackColor
            .CellForeColor = Debuger.NormalTextColor
            .CellFontBold = False
        End If
    End With
End Sub


Public Sub HighLightExecutingLine(LineNum As Integer)
    With DebugWindow
        .Row = LineNum
        .Col = 1
        If .TextMatrix(LineNum, 3) = "" Then
            Set .CellPicture = imgListDebugWindow.ListImages("Step").Picture
            .CellPictureAlignment = flexAlignCenterCenter
            .Col = 2
            .CellBackColor = Debuger.ExecutionColor
            .CellForeColor = Debuger.ExecutionTextColor
            .CellFontBold = False
        ElseIf .TextMatrix(LineNum, 3) = "BP" Then
            Set .CellPicture = imgListDebugWindow.ListImages("Both").Picture
            .CellPictureAlignment = flexAlignCenterCenter
            Call EnableDisableButtons("Pause", False)
            Call EnableDisableButtons("Start", True)
            If RunToCursor = True Then
                RunToCursor = False
                Call DrawPicture
                Call Effects
            End If
        End If
        
        If LineNum Mod 10 = 0 And LineNum > 10 Then _
            .TopRow = LineNum - 10
    End With
End Sub

Private Sub StartSimulation()
    Dim i As Integer
    Dim Code$
    
    If FindBilletSize = False Then Exit Sub
    Call DrawWorkPiece(WorkPieceLength, WorkPieceDiameter)
    FromX = WorkPieceDiameter
    FromZ = PicWidth - ToolWidth - 20 - WorkPieceLength
    Call DrawTool(FromZ, FromX)
    Call DrawPicture
    
    
    ProgressBar.Max = DebugWindow.Rows
    ProgressBar.Value = 0
    
    For i = 0 To DebugWindow.Rows - 1
        ProgressBar.Value = i + 1
        CurrentLineNumber = i
        Code = DebugWindow.TextMatrix(CurrentLineNumber, 2)
        If StopSimulation Then Exit Sub
        Call RemoveHighLighting(i - 1)
        Call HighLightExecutingLine(i)
        DoEvents
        If Left(Code, 1) = "[" Then GoTo Nextline  'encountered a comment
        
        Dim j As Integer    'search for comment at the end of line
        j = InStr(Code, "[")
        If j = 0 Then  'no comment found
            Call Process(Code)  ' process each line
        Else    'remove comment and process line
            'MsgBox Left(Code, J - 1) 'Call Process(Left(Code, J - 1))  ' process each line
        End If
        
        DoEvents
        'Sleep 50
Nextline:
    If Toolbar.Buttons.Item("Step").Value = tbrPressed Then
        Call mnuRunPause_Click
        EnableDisableButtons "Step", True
    End If
    Next i