主界面.frm

用vb写的数控仿真系统

         Begin VB.Menu MENU_DOG 
            Caption         =   "可爱小狗"
         End
         Begin VB.Menu MENU_PEOPLE 
            Caption         =   "卡通少女"
         End
      End
      Begin VB.Menu MENU_BAR10 
         Caption         =   "-"
      End
      Begin VB.Menu MENU_EXIT 
         Caption         =   "退出(&E)"
         Shortcut        =   ^Q
      End
   End
   Begin VB.Menu MENU_EDIT 
      Caption         =   "编辑(&E)"
      Visible         =   0   'False
      Begin VB.Menu MENU_COPY 
         Caption         =   "复制(&C)  Ctrl+C"
      End
      Begin VB.Menu MENU_CUT 
         Caption         =   "剪切(&X)  Ctrl+X"
      End
      Begin VB.Menu MENU_PASTE 
         Caption         =   "粘帖(&P)  Ctrl+V"
      End
      Begin VB.Menu MENU_BAR3 
         Caption         =   "-"
      End
      Begin VB.Menu MENU_DELETE 
         Caption         =   "删除(&D)  Del"
      End
      Begin VB.Menu MENU_SELECT 
         Caption         =   "全选(&A)  Ctrl+A"
      End
   End
   Begin VB.Menu MENU_OPERATE 
      Caption         =   "运行(&R)"
      Visible         =   0   'False
      Begin VB.Menu MENU_RUN 
         Caption         =   "运行仿真(&R)"
         Shortcut        =   {F5}
      End
      Begin VB.Menu MENU_PAUSE 
         Caption         =   "暂停"
         Shortcut        =   {F6}
      End
      Begin VB.Menu MENU_STOP 
         Caption         =   "停止"
         Shortcut        =   {F7}
      End
      Begin VB.Menu MENU_Config 
         Caption         =   "设置视图参数"
      End
      Begin VB.Menu MENU_LoadPG 
         Caption         =   "打开画图形到G代码程序"
      End
   End
   Begin VB.Menu MENU_HELP 
      Caption         =   "帮助(&H)"
      Visible         =   0   'False
      Begin VB.Menu MENU_HELPTOPIC 
         Caption         =   "帮助主题(&T)"
         Shortcut        =   {F12}
      End
      Begin VB.Menu MENU_BAR2 
         Caption         =   "-"
      End
      Begin VB.Menu MENU_ABOUT 
         Caption         =   "关于本程序(&A)"
         Shortcut        =   {F11}
      End
      Begin VB.Menu Menu_Bar5 
         Caption         =   "-"
      End
   End
   Begin VB.Menu MENU_VIEW 
      Caption         =   "视图"
      Visible         =   0   'False
      Begin VB.Menu MENU_XYZ 
         Caption         =   "等轴测图"
         Shortcut        =   {F9}
      End
      Begin VB.Menu MENU_XY 
         Caption         =   "XY平面"
         Shortcut        =   {F8}
      End
      Begin VB.Menu Menu_Bar4 
         Caption         =   "-"
      End
      Begin VB.Menu MENU_HowToCircle1 
         Caption         =   "无插补仿真(光滑)"
      End
      Begin VB.Menu MENU_HowToCircle2 
         Caption         =   "有插补仿真(粗糙)"
      End
      Begin VB.Menu MENU_SCALE 
         Caption         =   "设置视图比例"
         Shortcut        =   {F4}
      End
      Begin VB.Menu Menu_LineWidth 
         Caption         =   "设置图形线宽(&W)"
      End
   End
End
Attribute VB_Name = "frmmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim TEMPCODETEXT As String, OPENf As Boolean, PopupConfig As Boolean
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub CodeEditor_KeyDown(KeyCode As Integer, Shift As Integer)  '对输入进行处理,以便G指令首字为绿色,数字为黄色显示
    On Error Resume Next
   Select Case KeyCode
   Case 78, 71, 88, 89, 90, 65, 66, 67, 85, 86, 87, 73, 74, 75, 82, 70, 83, 84, 77, 80, 81, 76, 68, 72
    If Shift <> 2 Then
     CodeEditor.SelColor = vbGreen
    End If
   Case 53
    If Shift = 1 Then
      CodeEditor.SelColor = vbGreen
    Else
      CodeEditor.SelColor = vbYellow
    End If
   Case 16 To 18
   Case Else
    CodeEditor.SelColor = vbYellow
   End Select
End Sub
Private Sub CodeEditor_KeyPress(KeyAscii As Integer)   '小写自动转换大写
  Select Case KeyAscii
  Case 110, 103, 120, 121, 122, 97, 98, 99, 117, 118, 119, 105, 106, 107, 114, 102, 115, 116, 109, 112, 113, 108, 100, 104
   KeyAscii = KeyAscii - 32
  End Select
End Sub
Private Sub CodeEditor_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)  '右键弹出编辑菜单,控件本身也有右键菜单,但为了支持颜色代码,自已编一个菜单
  If Button = 2 Then
     PopupMenu MENU_EDIT
  End If
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)   '因菜单隐藏后不支持快捷键,故捕捉键盘输入作为快捷键
   Select Case KeyCode
   Case 116    '快捷键 F5
      MENU_RUN_Click
   Case 78     '快捷键 Ctrl+N
      If Shift = 2 Then
         MENU_NEW_Click
         KeyCode = 0
      End If
   Case 112    '快捷键 F1
         MENU_NEW_Click
         KeyCode = 0
   Case 113    '快捷键 F2
         MENU_OPEN_Click
         KeyCode = 0
   Case 114    '快捷键 F3
         MENU_SAVE_Click
         KeyCode = 0
   Case 115    '快捷键 F4
         MENU_SCALE_Click
         KeyCode = 0
   Case 119    '快捷键 F8
         MENU_XY_Click
         KeyCode = 0
   Case 120    '快捷键 F9
         MENU_XYZ_Click
         KeyCode = 0
   Case 79     '快捷键 Ctrl+O
      If Shift = 2 Then
         MENU_OPEN_Click
         KeyCode = 0
      End If
   Case 83     '快捷键 Ctrl+S
      If Shift = 2 Then
         MENU_SAVE_Click
         KeyCode = 0
      End If
   Case 81      '快捷键 Ctrl+Q
      If Shift = 2 Then
         MENU_EXIT_Click
         KeyCode = 0
      End If
   Case 80       '快捷键 Ctrl+P
      If Shift = 2 Then
         MENU_PAUSE_Click
         KeyCode = 0
      End If
   Case 117       '快捷键 F6
      MENU_PAUSE_Click
   Case 118
      MENU_STOP_Click   '快捷键 F7
   Case 122             '快捷键 F12
      MENU_ABOUT_Click
   Case 123             '快捷键 F11
      MENU_HELPTOPIC_Click
   End Select
End Sub
Private Sub Form_Load()
   Dim ShowWindow As Integer, CloseWindow As Integer
   On Error Resume Next
   Me.Hide
   frmAbout.Show      '关于对话框
   For ShowWindow = 0 To 1000
      For CloseWindow = 0 To 500
        DoEvents
      Next CloseWindow
   Next ShowWindow
   Unload frmAbout
   Me.Show
   PicDraw.ScaleHeight = -PicDraw.ScaleHeight    '定义坐标轴
   PicDraw.ScaleLeft = PicDraw.ScaleWidth / -2
   PicDraw.ScaleTop = -PicDraw.ScaleHeight / 2
   TEMPCODETEXT = ""
   If Command$ <> "" Then
      CodeEditor.LoadFile Trim$(Command$)
      TEMPCODETEXT = CodeEditor.Text
      OPENf = True
   End If
   SCALESIZE = 20      '默认比例
   CodeEditor.SelColor = vbYellow
   Call IniLoad
   LineW = 3     '默认线宽
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)  '用于判断有没有更改内容
   If OPENf = True Then
      TEMPCODETEXT = CodeEditor.Text
      OPENf = False
   End If
End Sub

Private Sub Form_Unload(Cancel As Integer)     '内容改变时退出提示保存
   Dim I As Integer
   If TEMPCODETEXT <> CodeEditor.Text Then
    I = MsgBox("在退出前保存文件吗？", vbYesNo, "保存文件")
   End If
   If I = vbYes Then
     Call MENU_SAVE_Click
   Else
     End
   End If
End Sub
Private Sub ImgEDIT_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) '弹出编辑菜单
   If Button = 1 Then
     ImgEDIT.Picture = LoadResPicture(104, 0)
     PopupMenu MENU_EDIT
     ImgEDIT.Picture = LoadResPicture(103, 0)
   End If
End Sub

Private Sub ImgExit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)  '退出按钮
   If Button = 1 Then
     ImgExit.Picture = LoadResPicture(110, 0)
     Unload Me
   End If
End Sub

Private Sub ImgFile_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)  '弹出文件菜单
   If Button = 1 Then
     ImgFile.Picture = LoadResPicture(102, 0)
     PopupMenu MENU_FILE
     ImgFile.Picture = LoadResPicture(101, 0)
   End If
End Sub
Private Sub Imghelp_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)  '弹出帮助菜单
   If Button = 1 Then
     Imghelp.Picture = LoadResPicture(108, 0)
     PopupMenu MENU_HELP
     Imghelp.Picture = LoadResPicture(107, 0)
   End If
End Sub

Private Sub ImgRUN_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)   '弹出编译菜单
   If Button = 1 Then
     ImgRUN.Picture = LoadResPicture(106, 0)
    PopupMenu MENU_OPERATE
     ImgRUN.Picture = LoadResPicture(105, 0)
   End If
End Sub



Private Sub MENU_ABOUT_Click()         '弹出关于对话框
lblState.Caption = "关于数控仿真系统"
frmAbout.Show
End Sub

Private Sub MENU_ABSXY_Click()     '例子:绝对坐标编程
  CodeEditor.Text = ""
  CodeEditor.SetFocus
  Clipboard.SetText LoadResString(107)
  SCALESIZE = 50
  Call MENU_PASTE_Click
End Sub
Private Sub MENU_TOXY_Click()     '例子:相对坐标编程
  CodeEditor.Text = ""
  CodeEditor.SetFocus
  Clipboard.SetText LoadResString(108)
  SCALESIZE = 50
  Call MENU_PASTE_Click
End Sub
Private Sub MENU_Enlarge_Click()
  CodeEditor.Text = ""
  CodeEditor.SetFocus
  Clipboard.SetText LoadResString(115)
  SCALESIZE = 30
  Call MENU_PASTE_Click
End Sub

Private Sub MENU_Config_Click()     '弹出设置菜单
   PopupConfig = True
   Timer2.Enabled = True
End Sub
Private Sub MENU_COPY_Click()
   lblState.Caption = "复制文本"
   Clipboard.Clear
   Clipboard.SetText CodeEditor.SelText
End Sub
Private Sub MENU_CUT_Click()
   lblState.Caption = "剪切文本"
   Clipboard.Clear
   Clipboard.SetText CodeEditor.SelText
   CodeEditor.SelText = ""
End Sub
Private Sub MENU_DELETE_Click()
 lblState.Caption = "删除文本"
 SendKeys Chr(8), True
End Sub



Private Sub MENU_EDIT_Click()
    lblState.Caption = "编辑菜单"
    If CodeEditor.SelText = "" Then
     MENU_COPY.Enabled = False
     MENU_CUT.Enabled = False
     MENU_DELETE.Enabled = False
    ElseIf Clipboard.GetText = "" Then
     MENU_PASTE.Enabled = False
    Else
     MENU_COPY.Enabled = True
     MENU_CUT.Enabled = True
     MENU_DELETE.Enabled = True
     MENU_PASTE.Enabled = True
    End If
End Sub
Private Sub MENU_EXIT_Click()
   End
End Sub

Private Sub MENU_FILE_Click()
lblState.Caption = "文件菜单"
End Sub
Private Sub MENU_HELP_Click()
   lblState.Caption = "帮助菜单"
End Sub

Private Sub MENU_HELPTOPIC_Click()   '帮助主题
  On Error Resume Next
  Dim ShellP As Long, HaveReadME As Boolean, TempLTXT As String
  If Dir(App.Path & "\数控编程仿真系统.hlp") <> "" Then
     ShellP = ShellExecute(hwnd, "Open", App.Path & "\数控编程仿真系统.hlp", "", "", 1)
     HaveReadME = True
  End If
  If Dir(App.Path & "\数控编程仿真系统.chm") <> "" Then
     ShellP = ShellExecute(hwnd, "Open", App.Path & "\数控编程仿真系统.chm", "", "", 1)
     HaveReadME = True
  End If
  If Dir(App.Path & "\数控编程仿真系统.htm") <> "" Then
     ShellP = ShellExecute(hwnd, "Open", App.Path & "\数控编程仿真系统.htm", "", "", 1)
     HaveReadME = True
  End If
  If Dir(App.Path & "\数控编程仿真系统.txt") <> "" Then
     ShellP = ShellExecute(hwnd, "Open", App.Path & "\数控编程仿真系统.txt", "", "", 1)
     HaveReadME = True
  End If
  If HaveReadME = False Then
    TempLTXT = LoadResString(109)