📄 天奇物流.frm
字号:
VERSION 5.00
Object = "{F1A8DFE4-BC61-48BA-AFDA-96DF10247AF0}#1.0#0"; "VISOCX.DLL"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmTQMF
Caption = "天奇物流"
ClientHeight = 9525
ClientLeft = 60
ClientTop = 750
ClientWidth = 19080
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 9525
ScaleWidth = 19080
WindowState = 2 'Maximized
Begin VisOcxCtl.DrawingControl drwArr
Height = 4095
Left = 0
TabIndex = 0
Top = 0
Width = 6975
HostID = ""
NegotiateMenus = 0 'False
NegotiateToolbars= 0 'False
PageSizingBehavior= 0
Src = ""
End
Begin VB.CommandButton cmd3DModel
Caption = "建立模型"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 12800
TabIndex = 4
Top = 8760
Width = 6400
End
Begin VB.CommandButton cmdDesign
Caption = "参数设计"
Default = -1 'True
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 6400
TabIndex = 3
Top = 8760
Width = 6400
End
Begin VB.CommandButton cmdArrange
Caption = "方案布置"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 0
TabIndex = 2
Top = 8760
Width = 6400
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 1
Top = 9150
Width = 19080
_ExtentX = 33655
_ExtentY = 661
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
End
Begin MSComDlg.CommonDialog dlgMF
Left = 6960
Top = 0
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Menu mnuFile
Caption = "文件"
Begin VB.Menu itmNew
Caption = "新建"
Shortcut = ^N
End
Begin VB.Menu itmOpen
Caption = "打开"
Shortcut = ^O
End
Begin VB.Menu 分隔符1
Caption = "-"
End
Begin VB.Menu itmSave
Caption = "保存"
Shortcut = ^S
End
Begin VB.Menu itmSaveAs
Caption = "另存为"
Shortcut = ^A
End
Begin VB.Menu 分隔符2
Caption = "-"
End
Begin VB.Menu itmExit
Caption = "退出"
Shortcut = ^X
End
End
Begin VB.Menu mnuWin
Caption = "窗口"
Begin VB.Menu itmArrange
Caption = "方案布置"
Shortcut = ^R
End
Begin VB.Menu itmPart
Caption = "参数设计"
Shortcut = ^P
End
End
Begin VB.Menu mnuHelp
Caption = "帮助"
Begin VB.Menu itmCourse
Caption = "使用说明"
Shortcut = ^C
End
Begin VB.Menu itmVersion
Caption = "版本"
Shortcut = ^V
End
End
End
Attribute VB_Name = "frmTQMF"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'变量blnChange被设置为False,用来指示文件上次保存时没有被修改.
'变量blnCancelSave被设置为False,用来指示用户在SaveAs对话框中没有选择Cancel按钮
Dim blnChange As Boolean, blnCancelSave As Boolean
Private Sub cmdDesign_Click()
'切换到参数设计界面
Load frmPart
frmPart.Show
Unload frmTQMF
End Sub
Private Sub drwArr_DocumentChanged(ByVal doc As Visio.IVDocument)
'文档被修改了
blnChange = True
End Sub
Private Sub Form_Load()
'设置drwArr控件的大小位置
drwArr.Top = 0: drwArr.Height = frmTQMF.ScaleHeight - cmdDesign.Height - StatusBar1.Height
drwArr.Width = frmTQMF.ScaleWidth
'加载visio模版文件
drwArr.Src = "f:\天奇参数化工程\方案布置模版.vsd"
'frmTQMF窗体标题栏显示"文件-方案布置"
frmTQMF.Caption = "文件-方案布置"
'方案布置和建立模型按钮不可用
cmdArrange.Enabled = False: cmd3DModel.Enabled = False
'方案布置菜单项不可用
itmArrange.Enabled = False
End Sub
Private Sub Form_Resize()
'让DrawingControl控件自动适应窗体大小
drwArr.Height = frmTQMF.ScaleHeight - cmdDesign.Height - StatusBar1.Height
drwArr.Width = frmTQMF.ScaleWidth
End Sub
Private Sub Form_Unload(Cancel As Integer)
Const conBtns As Integer = vbYesNoCancel + vbExclamation _
+ vbDefaultButton3 + vbApplicationModal
Const conMsg As String = "Do you want to save the current document?"
Dim intUserResponse As Integer
If blnChange = True Then 'document was changed since last save
intUserResponse = MsgBox(conMsg, conBtns, "Editor")
Select Case intUserResponse
Case vbYes 'user wants to save current document
Call itmSave_Click
If blnCancelSave = True Then 'user canceled save
Cancel = 1 'return to document-don't unload form
End If
Case vbNo 'user does not want to save current document
'unload form and exit
Case vbCancel
Cancel = 1 'return to document-don't unload form
End Select
End If
End Sub
Private Sub itmExit_Click()
'退出程序
Unload frmTQMF
End Sub
Private Sub itmNew_Click()
Const conBtns As Integer = vbYesNoCancel + vbExclamation _
+ vbDefaultButton3 + vbApplicationModal
Const conMsg As String = "Do you want to save the current document?"
Dim intUserResponse As Integer
If blnChange = True Then '文件自上次保存后已被改变
intUserResponse = MsgBox(conMsg, conBtns, "Editor")
Select Case intUserResponse
Case vbYes '用户希望保存当前文档
Call itmSave_Click
If blnCancelSave = True Then
Exit Sub
End If
Case vbNo '用户不希望保存当前文档
Case vbCancel '用户取消新建命令
Exit Sub
End Select
End If
'新建文档
drwArr.Src = ""
drwArr.Src = "f:\天奇参数化工程\方案布置模版.vsd"
blnChange = False 'reset variable
frmTQMF.Caption = "文件-方案布置"
dlgMF.FileName = ""
End Sub
Private Sub itmOpen_Click()
Const conBtns As Integer = vbYesNoCancel + vbExclamation _
+ vbDefaultButton3 + vbApplicationModal
Const conMsg As String = "Do you want to save the current document?"
Dim intUserResponse As Integer
On Error GoTo OpenErrHandler
dlgMF.CancelError = True
If blnChange = True Then '文件自上次保存后已被更改
intUserResponse = MsgBox(conMsg, conBtns, "Editor")
Select Case intUserResponse
Case vbYes '用户希望保存当前文档
Call itmSave_Click
If blnCancelSave = True Then '用户取消"保存"操作
Exit Sub
End If
Case vbNo '用户不保存当前文档
'process instructions below End If
Case vbCancel '用户取消"打开"操作
Exit Sub
End Select
End If
'用户选择要打开的文件
dlgMF.Filter = "Visio Files(*.vsd)|*.vsd|All Files(*.*)|*.*"
dlgMF.FileName = ""
dlgMF.ShowOpen
drwArr.Src = dlgMF.FileName
blnChange = False
frmTQMF.Caption = dlgMF.FileName
Exit Sub
OpenErrHandler:
End Sub
Private Sub itmPart_Click()
'切换到参数设计界面
Load frmPart
frmPart.Show
Unload frmTQMF
End Sub
Private Sub itmSave_Click()
If frmTQMF.Caption = "文件-方案布置" Then
Call itmSaveAs_Click '未保存过的文档
Else '已经保存过的文档
drwArr.Document.SaveAs (frmTQMF.Caption)
blnChange = False
End If
End Sub
Private Sub itmSaveAs_Click()
On Error GoTo SaveErrHandler
dlgMF.CancelError = True
'下面这行代码设置了SaveAS对话框的Flags属性.如果用户试着用已存在的文件名保存文件,cdlOFNOverwritePrompt提示SaveAs对话框产生警告信息,
'需要用户确认是否覆盖已存在的文件.如果用户输入一个不存在的路径,cdOFNPathMustExist使得SaveAs对话框产生警告信息.
dlgMF.Flags = cdlOFNOverwritePrompt + cdlOFNPathMustExist
dlgMF.Filter = "Visio Files(*.vsd)|*.vsd"
dlgMF.ShowSave
drwArr.Src = ""
drwArr.Document.SaveAs (dlgMF.FileName)
frmTQMF.Caption = dlgMF.FileName
blnChange = False
blnCancelSave = False
SaveErrHandler:
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -