📄 frmmain.frm
字号:
'***************************************
' Add a new DataItem to this checkpoint.
'***************************************
' Get the checkpoint we are adding to.
Set cp = GImport.GetCheckPoint(GCurrentTreeNode.parent.key)
' Add a new DataItem with a default name.
Set di = cp.AddDataPoint(True)
' Add the dataitem to our display tree.
AddTreeItem GCurrentTreeNode.key, di.GetID, _
di.name, etiType.tidataitem, "DataItem"
' Need to save now!
GImport.dirty = True
' Free our objects.
Set di = Nothing
Set cp = Nothing
Exit Sub
eHandler:
LogError "frmMain", "mnuTreeAddDataItem", Error(Err), False
End Sub
Private Sub mnuTreeAddOutputDefinition_Click()
tiAddOutputDefinition
End Sub
Private Sub mnuTreeCopy_Click()
mnuEditCopy_Click
End Sub
Private Sub mnuTreeCut_Click()
mnuEditCut_Click
End Sub
Private Sub mnuTreeDelete_Click()
tiDelete
End Sub
Private Sub mnuTreeEditOutputSchema_Click()
Dim sch As New COutputSchema
Dim arc As New CArchive
Dim ols As COutputLinks
If frmDocument.TreeView1.SelectedItem Is Nothing Then Exit Sub
' Get the outputlinks that owns this schema.
Set ols = GImport.GetOutputLinksManager _
(frmDocument.TreeView1.SelectedItem.parent.key)
If ols Is Nothing Then Exit Sub
' Load the schema.
arc.fileName = ols.SchemaFileLastKnownLocation
If Not arc.OpenFile() Then
arc.fileName = ols.LocateSchemaFile()
If arc.fileName = "" Then Exit Sub
End If
If sch.Load(arc) Then
Dim fileName As String
fileName = sch.Edit()
If GFormReturnValue = vbOK Then
' The name of the output source may have changed.
frmDocument.TreeView1.SelectedItem.Text = sch.name
' The file may have been saved with a different name.
If fileName <> "" Then
ols.SchemaFileLastKnownLocation = fileName
End If
End If
End If
Set ols = Nothing
End Sub
Private Sub mnuTreeEditRelationships_Click()
Dim ol As COutputLinks
Set ol = GImport.GetOutputLinksManager(frmDocument.TreeView1.SelectedItem.key)
' Show the links mapping form.
frmIOMapping.SetLinksReference ol
Set ol = Nothing
frmIOMapping.Show vbModal
End Sub
Private Sub mnuTreePaste_Click()
mnuEditPaste_Click
End Sub
Private Sub mnuTreeProperties_Click()
On Error GoTo eHandler
Dim ItemType As etiType
Dim obj As Object
GFormReturnValue = vbCancel
Set obj = tiGetTreeItem()
If obj Is Nothing Then Exit Sub
ItemType = tiGetSelectedItemType()
Select Case ItemType
Case etiType.tiimport
frmImportProperties.Show vbModal
frmDocument.TreeView1.SelectedItem.Text = GImport.name
Case etiType.ticheckpoint
Case etiType.tidataitem
Case etiType.tiDataItemAction, etiType.tiCheckpointAction, _
etiType.tiImportAction
' Get the parent object so we will have a name to
' associate with the command.
Dim parent As Object
If ItemType = tiImportAction Then
Set parent = tiGetTreeItem(frmDocument.TreeView1.SelectedItem.parent.parent.key)
Else
Set parent = tiGetTreeItem(frmDocument.TreeView1.SelectedItem.parent.key)
End If
obj.EditProperties parent.name, GImport
frmDocument.TreeView1.SelectedItem.Text = obj.GetSpecificDescription
Case etiType.tioutputlinks
obj.Edit
' The name of the output source may have changed.
frmDocument.TreeView1.SelectedItem.Child.Text = obj.OutputSourceName
frmDocument.TreeView1.SelectedItem.Text = obj.name
End Select
If GFormReturnValue = vbOK Then
' Need to save now!
GImport.dirty = True
End If
Exit Sub
eHandler:
LogError "frmMain", "mnuTreeProperties", Error(Err), False
'Resume
End Sub
Private Sub mnuViewBrowser_Click()
'Dim frmB As New frmBrowser
'frmB.StartingAddress = "http://www.microsoft.com"
'frmB.Show
End Sub
Private Sub mnuHelpAbout_Click()
frmAbout.Show vbModal, Me
End Sub
Private Sub mnuViewProjectWindow_Click()
MainDocumentVisible
End Sub
Private Sub mnuViewStatusBar_Click()
If mnuViewStatusBar.Checked Then
sbStatusBar.Visible = False
mnuViewStatusBar.Checked = False
Else
sbStatusBar.Visible = True
mnuViewStatusBar.Checked = True
End If
End Sub
Private Sub mnuViewToolbar_Click()
If mnuViewToolbar.Checked Then
tbToolBar.Visible = False
mnuViewToolbar.Checked = False
Else
tbToolBar.Visible = True
mnuViewToolbar.Checked = True
End If
End Sub
Private Sub tbToolBar_ButtonClick(ByVal Button As ComctlLib.Button)
Select Case Button.key
Case "New"
LoadNewDoc
Case "New"
mnuFileNewProject_Click
Case "Open"
mnuFileOpen_Click
Case "Save"
mnuFileSave_Click
Case "Print"
'mnuFilePrint_Click
Case "Cut"
mnuEditCut_Click
Case "Copy"
mnuEditCopy_Click
Case "Paste"
mnuEditPaste_Click
Case "Exclamation"
RunImport
End Select
End Sub
Private Sub mnuHelpContents_Click()
Dim nRet As Integer
'if there is no helpfile for this project display a message to the user
'you can set the HelpFile for your application in the
'Project Properties dialog
If Len(App.HelpFile) = 0 Then
MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption
Else
On Error Resume Next
nRet = OSWinHelp(Me.hwnd, App.HelpFile, 3, 0)
If Err Then
MsgBox Err.Description
End If
End If
End Sub
Private Sub mnuHelpSearch_Click()
Dim nRet As Integer
'if there is no helpfile for this project display a message to the user
'you can set the HelpFile for your application in the
'Project Properties dialog
If Len(App.HelpFile) = 0 Then
MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption
Else
On Error Resume Next
nRet = OSWinHelp(Me.hwnd, App.HelpFile, 261, 0)
If Err Then
MsgBox Err.Description
End If
End If
End Sub
Private Sub mnuWindowArrangeIcons_Click()
Me.Arrange vbArrangeIcons
End Sub
Private Sub mnuWindowCascade_Click()
Me.Arrange vbCascade
End Sub
Private Sub mnuWindowTileHorizontal_Click()
Me.Arrange vbTileHorizontal
End Sub
Private Sub mnuWindowTileVertical_Click()
Me.Arrange vbTileVertical
End Sub
Private Sub mnuEditCopy_Click()
Dim obj As Object
Dim objtype As etiType
Set obj = tiGetTreeItem()
objtype = tiGetSelectedItemType()
tiSetCutCopyPasteItem obj.Copy(), objtype
End Sub
Private Sub mnuEditCut_Click()
tiSetCutCopyPasteItem tiGetTreeItem(), tiGetSelectedItemType()
tiDelete
End Sub
Private Sub mnuEditPaste_Click()
Dim obj As Object
Dim objtype As etiType
' Get the clipboard object to be pasted.
tiGetCutCopyPasteItem obj, objtype
tiPutItem obj, objtype
' The user may try to paste the same object more than
' once so make a new copy of the this item with a new ID.
tiSetCutCopyPasteItem obj.Copy, objtype
End Sub
Private Sub mnuFileOpen_Click()
Dim sFile As String
' Make sure the current project is saved if neccessary.
If Not CanDeleteProject Then Exit Sub
If Not Archive.BrowseFileOpen("Open project file", , _
"Project Files (*.import)|*.import|All Files (*.*)|*.*") Then
Exit Sub
End If
Set GImport = Nothing
Set GImport = New CImport
If Not GImport.Load(Archive) Then
LogError "frmMain", "mnuFileOpen", "Unable to load import file", False
Else
FillCheckPointTree
Archive.CloseFile
End If
End Sub
Private Sub mnuFileClose_Click()
' Make sure the current project is saved if neccessary.
If Not CanDeleteProject Then Exit Sub
Set GImport = Nothing
' Create the default project.
Set GImport = New CImport
GImport.name = "Default Project"
End Sub
Private Sub mnuFileSave_Click()
If Archive.fileName = "" Then
If Not Archive.BrowseFileSave("Save project file", _
Archive.fileName, _
"Project Files (*.import)|*.import|All Files (*.*)|*.*") Then
Exit Sub
End If
End If
' Save the project file.
GImport.Save Archive
Archive.CloseFile
End Sub
Private Sub mnuFileSaveAs_Click()
If Archive.BrowseFileSave("Save project file", Archive.fileName, _
"Project Files (*.import)|*.import" & _
"|All Files (*.*)|*.*") Then
GImport.Save Archive
Archive.CloseFile
End If
End Sub
Private Sub mnuFileSaveAll_Click()
Call mnuFileSave_Click
End Sub
Private Sub mnuFilePageSetup_Click()
dlgCommonDialog.ShowPrinter
End Sub
Private Sub mnuFileExit_Click()
'unload the form
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -